28234-6029-RU-00 

(NASA-CR-1477571  LACIE  PERFORMANCE  N76-2^632 

PREDICTOR  FINAL  OPERATIONAL  CAPABILITY 
PROGRAM  DEJSCRIPTION,  VOLUME  3 I TRW  SYSTEMS 

GROUP)  ^ . P HC  CSCL  02C  UN  CL  AS 

G3/43  42118 

LACIE  PERFORMANCE  PREdTcTOR 
FINAL  OPERATIONAL  CAPABILITY 
PROGRAM  DESCRIPTION 

VOLUME  III 

MAY  1976 


CROP  INVENTORY 


Prepared  for 

NATIONAL  AERONAUTICS  AND  SPACE  ADMINISTRATION 
Lyndon  Johnson  Space  Center 
Houston,  Texas 


JViHA976  , 


Contract  Number  NAS-9-14547 


ONE  SPACE  PARK  • REDONDO  BEACH  • CALIFORNIA  90278 


^FDiS^ 


28234-6029-RU-00 


LACIE  PERFORMANCE  PREDICTOR 
FINAL  OPERATIONAL  CAPABILITY 
PROGRAM  DESCRIPTION 

VOLUME  III 

MAY  1976 


Prepared  for 

NATIONAL  AERONAUTICS  AND  SPACE  ADMINISTRATION 
Lyndon  Be  Johnson  Space  Center 
Houston,  Texas 


Contract  Number  NAS“9«14547 


TRW 

SYSrSMS  GROUP 

ONESPACEPARK  • REDONDO  BEACH  • CALIFORNIA  90278 


28234-6029-RU-00 
Page  i 


This  document,  in  three  v'oiomes, 
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IjACIE  Performance  Predictor  pro- 
duced under  Contract  NAS9- 14547, 
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Problem  Description  for  the 
LEM  Program 


1,0  SCOPE 

This  document  describes  the  requirements  and  processing  logic 
for  the  LACIE  Error  Model  program  (LEM).  This  program  is  an 
integral  part  of  the  Large  Area  Crop  Inventory  Experiment  (LACIE) 
system. 

1.  1 PROGRAM  CAPABILITIES 

LEM  is  that  portion  of  the  LPP  (LACIE  Performance  Predictor) 
which  simulates  the  sample  segment  classification,  strata  yield  estima- 
tion, and  production  aggregation.  LEM  controls  repetitive  Monte  Carlo 
trials  based  on  input  error  distributions  to  obtain  statistical  estimates 
of  the  wheat  area,  yield,  and  production  at  different  levels  of  aggregation, 
LEM  interfaces  with  the  rest  of  the  LPP  through  a set  of  data  files.  The 
input  files  for  LEM ’consist. of  the  following: 

0 Segment  ID  file 

o Crop  Calendar  file 

o Substrata  Historical  file 

0 CAMS  Error  Model  file 

o YES  Error  Model  file 

o Signature  Extension  file 

© Data-  Acquisition  file 

The  program  generates  two  output  files  for  use  by  the  output 
processor. 

In  addition,  three  intermediate  files  (Segment  Truth  file,  CAMS 
Output  file,  and  YES  Output  file)  are  generated  by  various  modules  within 
LEM  and  may  be  saved  for  subsequent  runs  on  the  LEM  program-per- 
mitting the  bypassing  of  specified  modules  on  those  runs. 
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1.  2 PROGRAM  DEVELOPMENT  AND  ORGANIZATION 

The  program  will  be  initially  developed  on  the  GDC  6600  'Timesharing 
system  and  later  converted  to  the  UNIVAC  1108  under  Exec  II  and  Exec  VIII. 
In  order  to  make  program  development,  modification,  check  out,  and  con- 
version easier,  tlie  following  guidelines  will  be  observed: 

a.  Modular  programming  techniques  will  be  used.  In 
particular,  the  LEM  program  will  contain  the  following 
subprograms: 

0 Segment  Truth  Generator 
0 CAMS  Simulator 
© YES  Simulator 

© CAS  Simulation 

b.  All  error  processing  will  be  through  a standard  error 
routine  ERRMES. 

c.  The  program  will  be  coded  in  ANSI  Standard  FORTRAN. 

To  provide  for  compatibility  between  the  CDC  6600  and 
the  UNIVAC  1108,  the  "Rules  for  Program  Development" 
written  by  G.  Hull  for  the  LACIE  Project  will  be  faithfully 
observed. 

d.  In  order  to  clarify  the  coding,  comments  will  be  used 
extensively  throughout  the  program.  In  parti  :ular: 

© Each  local  quantity  will  be  described  within  the  sub- 
routine using  it, 

0 Comments  will  be  used  to  relate  the  coding  to  the 
Problem  Definition  and  Flow  Charts. 
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1.  3 OPERATIONAL  ASSUMPTIONS 

« Only  1 case  may  be  ran  at  a time. 

e Only  1 country  may  be  considered  in  a case. 

® A maximum  of  999  Monte  Carlo  trials  may  be  run  in  a case 

and  a maximum  of  100  trials  may  be  executed  on  any  given  run. 

o A maximum  of  4 crop  calendar  windows  and  14  additional 
prediction  points  can  be  processed. 

o A maximum  of  10  regions  per  country  can  be  processed. 

o A maximum  of  50  zones  per  country  can  be  processed, 

o A maximum  of  20  strata  per  zone  can  be  processed,  ^ 

© A maximum  of  325  strata  per  country  can  be  processed, 

© A maximum  of  60  substrata  per  strata  can  be  processed. 

e A maximum  of  3200  substrata  per  country  can  be  processed. 

© A maximum  of  300  substrata  per  zone  can  be  processed, 

o A maximum  of  4000  segments  per  country  can  be  processed, 

o A maximum  of  300  acquired  segments  per  zone  can  be  processed. 

© A maximum  of  4000  segments  per  country  can  be  processed. 

o All  control  card  input  data  will  be  echo  printed.  

o All  control  card  input  data  will  be  checked  for  errors  before 

any  error  will  cause  the  processing  of  a case  to  terminate.  ' 

o In  a repetitive  Monte  Carlo  trial  case,  normally  the  i idividual 
subprogram  reports  will  be  allowed  to  print  during  the  first 
and  last  trial  only.  An  option  will  exist  to  eliminate  all  reports  or 
allow  printing  of  all  reports  for  each  trial  or  for  just  the  last  trial. 

• All  input  data  files  will  be  checked  for  correct  case  numbers. 

• The  program  will  require  less  than  20,  000  words  of  storage 
in  the  CPU  of  the  UNIVAC  110  8. 

e The  program  will  have  a restart  capability  which  will  allow  the 
program  to  continue  with  additional  Monte  Carlo  iterations  start- 
ing from  the  last  iteration  of  the  previous  run. 

o All  files  will  be  in  country,  region,  zone,  stratum,  substratum 
and  segment  order  (to  whatever  level  that  is  appropriate), 
o A maximum  of  10  classes  will  exist  in  a zone. 
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2.  0 INPUT 

There  are  one  control  card  set  and  np  to  seven  files  required  for 
input  to  the  LEM  program.  The  control  card  set  specifies  the  problem 
title,  the  initial  random  number  seeds,  and  various  program  control 
flags.  The  following  files  may  be  generated  by  other  programs  within 
the  LACIE  system  and  input  to  LEM': 

© Segment  ID  file 

o Crop  Calendar  .file 

® Substrata  Historical  file 

o CAMS  Error  Model  file 

o YES  Error  Model  file 

© Signature  Extension  file 

o Data  A cquisition  file 

In  addition,  the  following  files  may  be  generated  by  LEM  on  one 
run  and  then  saved  and  input  back  into  LEM  on  a subsequent  run: 

o Segment  Truth  file  @ CAS  Cumulative  Output  File 

® CAMS  Output  file  o CAS  Distribution  Output  File 

o YES  Output  file 

2,1  CARD  INPUT 

2.  1,  I List  of  Data  Quantities 

See  Input  Data  Description  sheet  on  the  following  pages, 

2,  1.  2 Card  Formats 

The  LEM  program  requires  four  control  cards.  Each  card  has  a 
fixed  field  format  as  shown  in  Figure  2-1. 

"LEM"  is  punched  in  columns  75-77  of  each  control  card  and  a 
sequence  number  is  punched  in  columns  79-80. 
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Card  1 


Card  2 


Card  3 


Card  4 


Header  card:  .Alphanumeric  problem  header  entered  in  Columns  1-60,  LEM  is  entered 
in  Columns  75-77  and  01  in  Columns  79-80. 


Figure  2-1.  Data  Card  Formats 
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Input  Data  Description 


Card 

Nominal 

Col. 

Name 

Dimension 

Value 

Range 

Description 

1-60 

TITLE 

10 

blanks 

1 

Problem  header  to  be  printed  at  the  top  of  each  output  page. 

(format  10A6) 

1-4’ 

ICASE 

* 1 
' 1 

1 

0 

0-9999 

Case  number 

6-11 

CUN TRY 

1 

-- 

— 

Country  (must  agree  with  ail  input  files). 

13t16 

NTRIAL 

1 

1 

1-9.99 

Total  number  of  Monte  Carlo  iterations  at  the  end  of  the  current  run 

(NTRIAL- 

{including  previous  runs 

if  this  is  a' restart).  NTRIAL  must  be  ^^100 

i 

RSTART  s 

• if  CAS  distribution  file  is  to  be  generated  (i,  e.  , if  DISTFF  y 0 in  CAS 

i 

100) 

input) 

17-19 

RSTART 

1 

0 ^ 

i 

1 

0-999 

Restart  Flag: 

= n 0 to  restart  after  n 

Monte  Carlo  iterations,  0 if  this  is  not  a 

i 

restart. 

20-22 

IPRINT 

1 

0 

0-3 

Iteration  Print  Flag  (for 

Segment  Truth  Generator) 

0 to  print  first  and  last  iterations;  1 to  print  each  iteration;  2 to 

O' 

print  last  iteration  only; 

3 to  suppress  printing. 

24-26 

STARTR 

1 

0 

0-999 

Starting  region  number. '| 

y Both  zero  or  both  non-zero 

28-30 

STARTZ 

1 

0 

0-999 

Starting  zone  number.  J 

32-34 

ENDR 

1 ' 

0 ■ 

0-999 

Ending  region  number.  ] 

L ^ 

^ Both  zero  or  both  non-zero 

36-38 

ENDZ 

1 

0 

0-999 

Ending  zone  number,  ^ 

39-41 

ISTG 

1 

0 

0-3 

Segment  Truth  Flag: 

0 to  vary  error  statistic: 

illy,  1 to  hold  error  constant  using  results  ^ 

i 

from  the  first  iteration  only,  2 to  hold  error  constant  using  a to 

previously  generated  Segment  Truth  file,  3 to  eliminate  the  Segment^ 

Truth  error  (error  is  zero). 

42-44 

ICAMS 

1 

0 

0-3 

CAMS  Error  Flag: 

Usage  is  similar  to  the  usage  of  the  Segment  Truth  flag  described 
above  except  that  for  the  case  in  which  ICAMS  = 2,  the  CAMS  Output 

I 

• 

file  IS  used. 

1 
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Input  Data  Description  ' 


Card 


Nomina 


Col. 

45^47 

48-50 

51-53 

54-56 

57-59 

* • 4 

66-68 

69-71 

72-74 


Name 
lYES  . 

lACQ  ' 

ICLASS 

ISEXT 

ISCC 

IPRCAM 

IPRYES 

IPRCAS 


Description 

YES  Error  Flag: 

Usage  is  similar  tb  the  usage  of  the  Segment  Truth  flag  described 
above  except  that  for  the  case  in  which  lYES  = 2,  the  YES  Output 
file  is  used. 

Segment  Acquisition  Flag: 

0 to  include  segment  acquisition  conditions,  1 to  eliminate  segment 
acquisition  conditions. 

Classification  Error  Flag; 

0 to  vary  classification  error  in  CAMS,  1 to  hold  the  classification 
error  constant,  2 to  eliminate  the  classification  error  (set  it  to  zero). 

Signature  Extension  Error  Flag: 

0 to  vary  Signature  Extension  Error,  1 to  hold  Signature  Extension 
Error  constant,  .2  to  eliminate  the  Signature  Extension  Error  (error 
is  zero). 

Segment  Crop  Calendar  Error: 

0 to  vary  the  error,  1 to  hold  the  error  constant,  2 to  eliminate  the 
error  (error  is  zero).  ' 

Iteration  print  flag  for  CAMS: 

Usage  is  similar  to  that  of  IPRINT. 

Iteration  print  flag  for  YES: 

Usage  is  similar  to  that  of  IPRINT. 

Iteration  print  flag  for  CAS: 

Usage  is  similar  to  that  of  IPRINT. 
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Input  Data  Description 


Card 

CoL 

. 1-4 

5-8 

9-12 

13-16 

17-20 

21-24 

25-28 

29-32 

33-36 

37-40 

49-60 

61-72 

00 

1-12 
13-24 
25-3  6 


Name 
ICSESG 

ICSECW 

ICSESH 

ICSECE 

ICSEYM 

ICSESE 

ICSEAC 

ICSEST 

ICSECO. 

ICSEYS 

RSEEDl 

RSEEr)2 


RSEED3 

RSEED4 

RSEED5 


Nominal( 

Dimension!  Value 


Range 

0-9999 

0-9999 

0-9999 

0-9999 

0-9999 

0-9999 

0-9999 
0-9999 
0-9999 

0- 9999 

1- 

999999999999 
1- 

999999999999 


Description 


Case  number  for  Segment  ID  file. 

Case  number  for  Crop  Calendar  file. 

Case  number  for  Substrata  Historical  file. 

Case  number  for  CAMS  Error  Model  file. 

Case  number  for  YES  Error  Model  file. 

Case  number  for  Signature  Extension  file. 

Case  number  for  Data  Acquisition  file. 

Case  number  for  Segment  Truth,  .file. 

Case  number  for  CAMS  Output  file. 

Case  number  for  YES  Output  file. 

Initial  random  number,  seed  for  Segment  Truth  Error  (odd  positiv« 
integer  inF-format). 

Initial  random  number  seed  for  Classification  Error. 


1- 

999999999999 

I 

999999999999 
1- 

999999999999 


Initial  random  number  seed  for  Signature  Extension  Error. 


Initial  random  number  seed  for  Segment  Crop  Calendar  Error, 


Initial  random  nu.mbef  seed  for  Yield  Error. 
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2.  1,  3 Deck  Set  Up 

Each  of  the  four  LEM  control  cards  is  required  and  they  must  be 
in  card  number  order.  In  addition,  control  cards  are  always  required 
for  the  CAMS  module  even  if  this  module  is  not  used.  If  CAMS  is  skipped 
(e.  g.  , ICAMS  = 2),  then  .the  corresponding  control  cards  must  still  be 
include  1.  Finally,  the  control  cards  for  CAS  must  always  be  specified. 
The  contents  and  format  of  the  CAMS  and  CAS  control  cards  are  specified 
in  the  Problem  Descriptions  for  CAMS  and  CAS. 

2.  1.  4 Rules  for  Entering  Data  on  Cards 

1.  Integers  must  be  right  justified. 

2.  Alphanumeric  fields  should  be  left  justified. 

3.  Real  (i.  e.  , floating  point)  fields  must  have  the  decimal  point 
present. 

2,  2 INPUT  FILES 

The  following  files  may  be  input  to  the  LEM  program: 


Source 

Destination 

Segment  ID  File 

LUMP 

STG 

Crop  Window  (Calendar)  File 

LUMP 

CAMS 

Substrata  Historical  File 

LUMP 

STG,  -CAS 

CAMS  Error  Model  File 

SEE 

CAMS 

YES  Error  Model  File 

SEE 

YES 

Signature  Extension  File 

SEE 

CAMS 

Data  Acquisition  File 

SACS 

CAMS 

Segment  Truth  File 

STG 

CAMS 

CAMS  Output  File 

CAMS 

CAS 

YES  Output  File 

YES 

CAS 

CAS  Cumulative  File 

CAS 

CAS 

CAS  Distribution  File 

CAS  . 

CAS 

Note  that  the  last  five  files  listed  above  are  generated  by  modules 
within  LEM.  They  may  be  saved  and  input  to  LEM  on  subsequent  runs. 
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2.3  RESTRICTIONS 

1.  In  general,  the  various  error  sources  may  be  independently 
varied,  held  constant,  or  eliminated  by  specifying  appropriate 
values  for  the  input  parameters  ISTG,  ICAMS,.  lYES,  ICLASS, 
ISEXT,  ISCC,  ICAS2,  and  ICAS3.  However,  the  user  may  not 
specify  ISTG  = 0 unless  ICAMS  is  also  zero.  The  reason  for 
this  restriction  is  that  if  ICAMS  = 1 or  3 for  example,  the  CAMS 
Output  file  will  be  generated  on  the  first  iteration  and  then  used 
on  all  subsequent  iterations.  If  ISTG  were  zero  indicating  that 
the  Segment  Truth  error  was  to  be  varied,  the  program  would 
be  in  trouble  because  to  vary  the  Segment  Truth  error  means 
that  the  results  on  the  CAMS  Output  file  must  also  be  variable 
even  if  the  CAMS  errors  are  constant  or  zero.  The  way 
around  this  restriction  is  to  specify  both  ICAMS  = 0 and 

ISTG  = 0 and  then  to  s'pecify  non-zero  values  for  ICLASS, 

ISEXT,  and  ISCC.  In  this  manner  the  CAMS  Output  file  will 
be  written  on  each  iteration  even  though  the  CAMS  errors  are 
really  constant. 

2.  The  variable  possible  combinations  of  the  input  parameters 
ICAMS,  ISTG,  lYES,  ICLASS,  ISEXT,  and  ISCC  as  well  as 
other  options  (CAMS  classification  model,  multi-temporal 
sampling,  and  acquisition  effects)  are  presented  in  the  chart 
on  the  following  page. 

3.  On  a restart  run  the  input  case  number  ICASE  must  agree  with 

the  case  number  on  both  of  the  following  files  which  may  be  input 
to  LEM: 

e CAS  Cumulative  Output  file 

o CAS  Distribution  Output  file 
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ICAMS 


ISEXT 

ISCC 

. ICLASS 

Model 

Multi- 
Temp 
■ Sampling 

ISTG 

lYES 

lACQ 

0 

0,  1.2 

0,  1,2 

O 

to 

1,  2 

0,  1 

0,  1,  2,  3 

0,  1 

,2,3 

0,  1 

1 

1,2 

1,  2 

1,  2 

1,  2 

0,1 

1,2,3 

0,  1 

2 

X 

X 

X 

X 

X 

X 

X 

3 

X 

X 

X 

1,2 

X 

3 

\ 

1 

0,  1 

For  ICAMS,  ISTG,  lYES 

0 ■ vary  error, 

1 • hold  error  constant;  use  first  iteration  results, 

2 ^ hold  error  constant;  use  previously  generated  file, 

3 — eliminate  error. 

For  ISEXT,  ISCC,  ICLASS 


0 

1 

2 


> vary  error. 


> hold  error  constant, 


eliminate  error. 


For  Multi- Temporal  Sampling 

0 : include  multi-temporal  sampling  effects, 

1 ' exclude  effects. 

For  Acquisition  Effects 

0 — ^ include  segment  acquisition  effects, 

1 ' eliminate  segment  acquisition  effects. 

Model  = 1 or  2 for  classification  model  1 or  2 respectively  in  CAMS 
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4.  On  a restart  run  the  CAS  Cumulative  Output  file  and  the  CAS 
Distribution  Output  file  must  always  be  specified„  In  addition, 
the  Segment  Truth  file,  the  CAMS  Output  file  and/or  the  YES 
Output  file  should  be  specified  if  the  input  flags  ISTG,  ICAMS, 
and/or  lYES  are  set  to  1,  2,  or  3.  Note,  however,  that  if  the 
CAMS  Output  file  is  specified,  then  it  is  not  necessary  to  specify 
the  Segment  Truth  file. 
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3.  0 PROCESSING 
3.  1 OVERVIEW 

The  LEM  program  consists  of  control  logic  to  execute  one  or  more 
application  subprogram.s  as  selected  by  the  user  through  the  control  card 
parameters.  The  effect  of  various  input  error  distributions  is  taken  into 
account  by  use  of  a Monte  Carlo  technique  employing  a random  number 
generator.  The  application  subprograms  are  as  follows: 

Segment  Truth  Generator 

This  subprogram  generates  true  proportion  of  wheat  and  the 
true  proportion  of  mixed  pixels  for  each  sample  segment. 

CAMS  Simulator 

This  subprogram  models  the  LACIE  segment  classification 
process  and  associated  errors  to  provide  an  estimate  of  the 
proportion  of  wheat  in  each  satellite  acquired  sample  segment 
and  a measure  of  the  classification  error. 

YES  Simulator 

This  subprogram  models  the  yield  estimation  process  and 
associated  errors  in  order  to  provide  an  estimate  of  the  wheat 
yield  for  each  strata  and  a measure  of  the  yield  error. 

CAS  Simulator 

This  subprogram  models  the  LACIE  aggregation  technique 
including  the  aggregation  of  wheat  area  and  production  to  the 
country  level  and  the  estimation  of  the  accuracy  of  the  aggre~ 
gation,  CAS  also  compares  the  estimates  to  the  truth  baseline 
to  compute  actual  errors. 

3.2  PROGRAM.FLOW 

An  overall  flow  diagi-am  of  the  LEM  program  is  presented  on 
Pages  14-16. 
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STAR' 


Call  START  to 
initialize  flags,  . 
counters,  storage 




Read  all 
control  cards 

Call  INIT  to 
perform  initializa- 
tion tasks 


Monte  Carlo  Loop 
I = RSTART  + 1.  , . , , NTRIAL 
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Call  INPCHK  to 
check  input  data  for 
errors;  read  header 

^ 

ERRMES 

writes 

error 

messages 

3TG  COXQ.S 

“1  1 
1 

STOP 


Call  ERRMC  to 
provide  Error  Model 
Control 
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3.  3 PROCEDURES  AND  EQUATIONS 
3,  3,  I Job  Initialization 

Initialize  storage,  flags,  and  counters, 
3.  3.  2 Read  All -Control  Cards 
(LEM,  CAMS,  and  CAS) 


3,  3.  3 Input  Check 

© Check  all  paranaeters  from  control  cards  for  errors. 

ffi  Read  header  records  of  all  input  files  and  compare  country 
and  case  number  from  each  file  to  input  values. 


3.  3.  4 Monte  Carlo  Loop 

Perform  steps  for  each  Monte  Carlo  trial, 

1.  CALL  ERRMC  to  properly  initialize  the  random  number 
seeds  for  the  various  error  sources  as  specified  by 
input  flags, 

2,  Obtain  the  Segment  Truth  data  by  calling  STG  or  by  having 
CAMS  read  from. the  Segment  Truth  file  as  specified  by 
the  Segment  Truth  error  flag. 

The  procedures  to  be  used  in  the  Segment  Truth  Generator 
are  as  follo-ws; 


Calculate  by  calling  BETAD  with 


mean  = FW 


K 


and 


standard  deviation  = ^^2 


0 Calculate  by  calling  BETAD  with 


mean  = PWj^  * (6PM)  and 
i 

. standard  deviation  = P^K  * PM)  * ^^3 

i 
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6PM  - ratio  of  mixed  pixels  to  true  proportion 

wheat 

3.  Obtain  the  CAMS  error  data  by  calling  CAMS  or  by  having  CAS  ■ 
read  from  the  CAMS  Output  file  as  specified  by  the  CAMS 
error  flag. 

4.  Obtain  the  YES  error  data  by  calling  YES  or  by  having  CAS  ' 
read  from  the  YES  Output  file  as  specified  by  the  YES 
error  flag. 

5..  Call  CAS 

3.  3.  5 Program  Termination 

After  the  final  Monte  Carlo  iteration,  call  WRAPUP  to  terminate 
the  job  properly. 
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4.0  OUTPUT 

The  LEM  program  produces  printed  reports  in  the  Segment  Truth 
Generator,  CAMS,  YES,  and  CAS  modules  and  generates  two  output  files 
for  further  processing  by  the  LEM  Post  Processor,  In  addition,  three 
intermediate  files  are  generated  by  the  Segment  Truth  Genei'ator,  CAMS, 
and  YES  modules.  Finally,  program  status  information  about  each  sub- 
program and  LEM  itself  after  each  Monte  Carlo  trial  and  at  the  end  of 
the  program  execution  are  printed  out. 

4.  1 PRINTED  DATA 

4.  1.  1 Printed  Reports 

Printed  reports  are  generated  by  the  Segment  Truth  Generator, 
CAMS,  YES,  and  CAS  modules.  The  Segment  Truth  Report  consists  of 
the  substrata  true  PW,  each  segment  true  PW,  and  each  segment  true  PM 
plus  the  average  segment  true  PW  for  each  substratum.  The  CAMS 
module  generates  two  reports  --  a CAMS  estimated  proportion  wheat  sum- 
mary and  an  error  source  report,  YES  generates  a report  specifying  the 
true  yield  of  each  stratum,  and  for  each  prediction  point  of  each  stratum, 
the  estimated  yield,  estimated  date,  standard  error,  and  percent  error. 
CAS  generates  a summary  report  for  the  LEM  simulation.  The  content 
and  format  of  the  CAMS,  YES,  and  CAS  modules  will  be  described  in  the 
Problem  Definitions  for  each  of  those  subprograms.  The  format  of  the 
Segment  Truth  report  is  as  follows: 


Segment  Truth  Report 


True 

True 

True 

Substrata 

Segment 

A ve. 

Error 

Segment 

PW 

PW 

PW 

PW 

PM 

XXX 

XXX 

XXX 

XXX 

XXX 

XXX 

XXX 

XXX 

• 

XXX 

• 

XXX 

XXX 

XXX 

XXX 

• 

XXX 

XXX 

XXX  ^ 
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4,  1.  2 Intermediate  Debug 

At  the  present  there  is  no  Intermediate  Debugging  printout  specified. 
However,  it  is  anticipated  that  during  checkout  the  contents  of  vax'ious 
files  will  be  printed  out  as  the  data  records  are  written. 

4.  1.  3 Status  Information 

At  the  conclusion  of  the  run  the  following  status  information  is 
printed  out: 

® Number  of  data  records  read  from  each  input  file 
© Number  of  non-fatal  errors  detected  in  the  input  data 

o Number  of  non-fatal  errors  detected  during  execution 

(!• 

© Number  of  Monte  Carlo  trials  completed 
© Final  random  number  seeds  (to  be  input  on  restart  run) 
o Number  of  data  records  written  on  each  output  file 

4.  1,4  Echo  Print  Input  Card  Images 

The  data  specified  on  the  input  control  cards  is  always  printed  out 
in  a format  that  is  similar  to  the  format  on  the  input  card  images. 

Due  to  differences  in  the  FORTRAN  read  and  write  formats,  the  printout 
may  be  slightly  different  from  the  input  card  images.  For  example,  a 
blank  field  will  be  printed  out  as  -0  rather  than  being  left  blank. 
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4.  2 FILES 

There  are  two  output  files  generated  by  LEM  --  the  CAS  Cumulative 
Output  File  and  the  CAS  Distribution  Data  File,  In  addition,  intermediate 
files  are  gener?,ted  by  the  Segment  Truth  Generator,  CAMS,  and  YES. 
These  intermediate  files  may  be  saved  and  input  on  subsequent  runs  allow- 
ing specified  subprograms  to  be  bypassed  provided  the  corresponding 
error  contributions  are  constant, 

4.  2.  1 CAS  Cumulative  Output  File  . ' 

This  file  contains  the  cumulative  information  being  generated  from 
Monte  Carlo  analysis. 

4,  2.  2 CAS  Distribution  Data  ' 

This  file  provides  distribution  data  to  be  analyzed  by  the  post 
processor. 

4.  2.  3 -Segment  Truth  File 

This  file  contains  all  of  the  essential  Segment  Truth  data.  It  may  be 
saved  and  input  to  LEM  on  a subsequent  run  allowing  the  Segment  Truth 
Generator  to  be  bypassed.  However,  on  that  subsequent  run  the  Segment 
Truth  data  will  be  constant. 

4.  2,  4 CAMS  Output  F ile 

This  file  contains  ail  of  the  essential  CAMS  output  data.  It  may  be 
saved  and  input  to  LEM  on  a subsequent  run. allowing  CAMS  to  be  bypassed. 
However,  on  that  subsequent  run  the  CAMS  data  will  be  constant. 

4.  2.  5 YES  Output  File 

This  file  contains  all  of  the  essential  YES  output  data.  It  may  be 
saved  and  input  to^  LEM  on  a subsequent  run  allowing  YES  to  be  bypassed. 
However,  on  that  subsequent  run  the  YES  data  will  be  constant. 


TfFPRODTJCIBILTrY  OP  TBH 

PAGE  IS  fOOM 
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5.  0 ERROR  PROCESSING 
5.  1 GENERAL 

The  program  will  attempt  to  find  as  many  errors  as  possible  during 
the  processing  of  the  input  control  cards.  The  program  will  continue 
checking  for  additional  input  errors  if  any  input  error  is  detected.  There 
are  two  levels  of  error.  These  are: 

Level  1 - non-fatal,  continue  processing. 

Level  2 - job  fatal.  Terminate  job  after  processing  all  input 
control  cards. 

When  a level  1 error  is  detected,  the  program  will  print  an  informative 
message  and  continue  processing.  When  a level  2 error  is  detected,  the 
program  will  print  an  informative  message,  set  a fatal  error  flag,  and 
continue  processing.  When  all  control  cards  have  been  processed  the 
program  will  continue  executing  if  no  fatal  errors  were  found  or  will 
return  control  back  to  the  operating  system  if  at  least  one  fatal  error  is 
detected. 

The  errors  which  may  be  detected  by  the  LEM  control  program 
itself  are  described  below.  Any  error  conditions  which  are  detected  by 
CAMS,  YES,  or  CAS  will  be  described  separately  in  the  Problem  Definitions 
for  CAMS,  YES,  or  CAS. 

5.  2 INPUT  ERRORS  DETECTED  BY  LEM  • 

1.  Message: 

TOO  MANY  MONTE  CARLO  TRIALS  REQUESTED.  NTRIAL  = n, 
RSTART  = r.  MAX.  NO.  OF  TRIALS  PER  RUN  IS  m. 

Meaning: 

On  the  LEM  control  cards  the  user  has  specified  n-r  Monte  Carlo  ' 
-trials  for  the  current  run  but  the  program  permits  a maximum  of 
m trials  for  any  single  run. 

Remedy: 

Fatal  error  --  the  user  should  check  NTRIAL  and  RSTART  and 
be  sure  NTRIAL-RSTART  does  not  exceed  the  maximum  allowable 
value. 
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2,  Message; 

RSTART  = r MUST  BE  LESS  THAN  NTRIAL  = n. 

Meaning; 

RSTART,  the  final  iteration  number  from  the’ previoas  r.an 
from  which  the  user  is  trying  to  restart,  must  be  less  than 
NTRIAL,  the  total  number  of  iterations  desired  at  the  end  of 
the  .current  run. 

Remedy; 

Fatal  error  RSTART  is  fixed.  Hence,  NTRIAL  must  be 
increased  on  the  LEM  control  cards, 

3,  Me  ssage; 

STARTR  = n^  MUST  BE  BETWEEN  0 AND  ENDR  = ENDR 
MUST  BE  , LE.  m,  . 

Meaning; 

The  starting  region  n^  and  the  ending  region  n^  must  satisfy 
the  inequalities 

0 ^ n^^  ^ ^ m 

where  m is  the  maximum  region  number. 

Remedy: 

Fatal  error  --  the  user  should  check  STARTR  and  ENDR  on  the 
LEM  control  cards  to  be  sure  they  satisfy  the  above  inequalities. 

4,  Message: 

STARTZ  = n^  MUST  BE  BETWEEN  0 AND  ENDZ  = ENDZ 
MUST  BE  , LE.  m. 

Meaning: 

The  starting  zone  n^^  and  the  ending  zone  n^  must  satisfy  the 
inequalities 

0 

where  m is  the  maximum  zone  number. 
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Remedy; 

Fatal  error  --  the  user  should  check  STARTZ  and  ENDZ  on 
the  LiEM  control  cards  to  be  sure  they  satisfy  the  above 
inequalities. 

5.  Me  ssage: 

ISTG  = n^,  ICAMS  = AND  lYES  = n^  MUST  ALL  BE  0,  1,  2, 
OR  3. 

Meaning: 

One  or  more  of  the  parameters  ISTG,  ICAMS,  and  lYES  have 
an  illegal  value  specified.  The  only  allowable  values  are  0,  1, 

2,  or  3.  ^ 

Remedy: 

Fatal  error  --  specify  the  proper  value (s)  for  the  offending 
p3-rameter(s)  on  the  LEM  control  cards. 

6.  Message: 

IF  ICAMS  IS  NONZERO,  THEN  ISTG  MUST  BE  NONZERO. 

I.E.  IF  THE  CAMS  ERRORS  ARE  HELD  CONSTANT,  THEN 
SO  MUST  THE  SEGMENT  TRUTH  ERROR. 

Meaning: 

Self-explanatory.  The  user  cannot  vary  the  Segment  Truth  error 
while  holding  the  CAMS  errors  constant  by  setting  ICAMS  4 0. 
However,  it  is  possible  to  hold  the  Segment  Truth  error  constant 
while  varying  the  CAMS  errors. 

Remedy: 

Fatal  error  --  change  either  ICAMS  or  ISTG  on  the  LEM  control 
cards. 
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7,  Message: 

CASE  NUMBER  = OR  COUNTRY  C^  FROM  SEGMENT  ID 
FILE  DOES  NOT  AGREE  WITH  INPUTS  ICSESG  = AND 
CUNTRY  = C-. 

Meaning: 

Possibly  the  wrong  Segment  ID  file  has  been  specified',  or  the 
wrong  values  have  been  specified' for  the  parameters  ICSESG 
and  CUNTRY  on  the  LEM  control  cards. 

Remedy: 

Fatal  error  --  mount  the  proper  Segment  ID  file  or  specify  the 
correct  values  for  ICSESG  and  CUNTRY  on  the  LEM  control 
cards.  It  might  be  necessary  to  dump  the  header  record  of  the 
Segment  ID  file. 

8.  Me  s sage: 

CASE  NUMBER  = n^  OR  COUNTRY  C^  FROM  CROP  WINDOW 
FILE  DOES  NOT  AGREE  Y/ITH  INPUTS  ICSECW  = n^  AND 
CUNTRY  = C^. 

Meaning: 

Possibly  the  wrong  Crop  Window  file  has  been  specified,  or  the 
wrong  values  have  been  specified  for  the  parameters  ICSECW 
and  CUNTRY  on  the  LEM  control  cards. 

Remedy: 

Fatal  error  --  mount  the  proper  Crop  Window  file  or  specify  the 
■ correct  values  for  ICSECW  and  CUNTRY  on  the  LEM  control  cards. 
It  might  be  necessary  to  dump  the  header  record  of  the  Crop 
Window  file. 
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9.  Message: 

CASE  NUMBER.  = OR  COUNTRY  C^  FROM  CAMS  ERROR 
FILE  DOES  NOT  AGREE  WITH  INPU  TSICSECE  = AND 
CUNTRY  = C^. 

Meaning: 

Possibly  the  wrong  CAMS  error  file  has  been  specified,  or  the 
wrong  values  have  been  specified  for  the  parameters  ICSECE 
and  CUNTRY  on  the  LEM  control  cards. 

Remedy: 

Fatal  error  --  mount  the  proper  CAMS  error  file  or  specify 
the  correct  values  for  ICSECE  and  CUNTRY  on  the  LEM  control 
cards.  It  might  be  necessary  to  dump  the  header  record  of  the 
CAMS  error  file. 

10.  Message: 

CASE  NUMBER  = n^  OR  COUNTRY  C^  FROM  THE  SIGNATURE 
EXTENSION  FILE  DOES  NOT  AGREE  WITH  INPU  TS  ICSESE  = n^ 
AND  CUNTRY  = C^. 

Meaning: 

Possibly  the  wrong  signature  extension  file  has  been  specified, 
or  the  wrong  values  have  been  specified  for  the  parameters 
ICSESE  and  CUNTRY  on  the  LEM  control  cards. 

Remedy: 

Fatal  error  --  mount  the  proper  signature  extension  file  or 
specify  the  correct  values  for  ICSESE  and  CUNTRY.  It  might 
be  necessary  to  dump  the  header  record  of  the  signature 
extension  file. 
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11,  Message: 

CASE  NUMBER  = OR  COUNTRY  C^^  FROM  THE  DATA 
ACQUISITION  FILE  DOES  NOT  AGREE  WITH  INPUTS  ICSEAC  = 
AND  CUNTRY  = C^. 

Meaning:  ■ 

Possibly  the  v/rong  Data  Acquisition  file  has  been  specified,  or 
the  wrong  values  have  been  specified  for  the  parameters  ICSEAC 
and  CUNTRY  on  the  LEM  control  cards. 

Remedy: 

Fatal  error  --  mount  the  proper  Data  Acquisition  file  or  specify 
the  correct  values  of  ICSEAC  and  CUNTRY^  It  might  be  necessary 
to  dump  the  header  record  of  the  Data  Acquisition  file. 

12,  Message: 

CASE  NUMBER  = n^^  OR  COUNTRY  FROM  THE  YES  ERROR 
MODEL  FILE  DOES  NOT  AGREE  WITH  INPUTS  IC SEYM  = n^ 

AND  CUNTRY  = C^. 

Meaning: 

Possibly  the  wrong  YES  Error  Model  file  has  been  specified  or 
the  wrong  values  have  been  specified  for  the  parameters  ICSEYM 
and  CUNTRY  on  the  LEM  control  cards. 

Remedy: 

Fatal  error  --  mount  the  proper  YES  Error  Model  file  or  specify 
the  correct  values  forICSEYMand  CUNTRY.  It  might  be  necessary 
to  dump  the  header  record  of  the  YES  Error  Model  file. 

13,  Me  s sage: 

CASE  NUMBER  = n^  OR  COUNTRY  C^  FROM  THE  SUBSTRATA 
HISTORICAL  FILE  DOES  NOT  AGREE  WITHINPUTS  ICSESH  = n^ 
AND  CUNTRY  = C^. 
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Meaning: 

Possibly  the  wrong  Substrata  Historical  file  has  been  specified 
or  the  wrong  values  have  been  specified  for  the  parameters 
ICSESH  and  CUNTRY  on  the  LEM  control  cards,  - 

Remedy: 

Fatal  error  --  mount  the  proper  Substrata  Historical  file  or 
specify  the  correct  values  for  ICSESH  and  CUNTRY.  It  might 
be  necessary  to  dump  the  header  record  of  the  Substrata 
Historical  file. 

14.  Message : 

CASE  NUMBER  = nj  OR  COUNTRY  = C^  FROM  THE  SEGMENT 
TRUTH  FILE  DOES  NOT  AGREE  WITH  INPUTS  ICSEST  = n^  AND 
CUNTRY  ■=  C^. 

Meaning: 

Possibly  the  wrong  file  has  been  specified  as  the  Segment  Truth 
file,  or  the  wrong  values  have  been  specified  for  ICSEST  and 
CUNTRY  on  the  LEM  control  cards. 

Remedy: 

Fatal  error  --  mount  the  proper  Segment  Truth  file  or  specify 
the  correct  values  for  ICSEST  and  CUNTRY.  It  might  be  necessary 
to  dump  the  header  record  of  the  Segment  Truth  file. 

15.  Message: 

CASE  NUMBER  = n^  OR  COUNTRY  = C^  FROM  THE  CAMS 
OUTPUT  FILE  DOES  NOT  AGREE  WITH  INPUTS  ICSECO  = 

AND  CUNTRY  = C2. 

- Meaning: 

Possibly  the  wrong  file  has  been  specified  as  the  CAMS  Output 
file,  or  the  wrong  values  have  been  specified  for  ICSECO  and 
CUNTRY  on  the  LEM  control  cards. 
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Remedy: 

Fatal  error  --  mount  the  proper  CAMS  Output  file  or  specify 
the  correct  values  for  ICSECO  and  CUNTRY.  It  might  be 
necessary  to  dump  the  header  record  of  the  CAMS  Output  file. 

16.  ■ Me  s sage: 

CASE  NUMBER  = n^  OR  COUNTRY  = C^^  FROM  THE  YES 
OUTPUT  FILE  DOES  NOT  AGREE  WITH  INPUTS  ICSEYS  = 

AND  CUNTRY  = C^. 

Meaning; 

Possibly  the  wrong  file  has  been  specified  as  the  YES  Output 
file,  or  the  wrong  values  have  been  specified  for  ICSEYS  and 
CUNTRY  on  the  LEM  control  cards. 

Remedy; 

Fatal  error  --  mount  the  proper  YES  Output  file  or  specify  the 
correct  values  for  ICSEYS  and  CUNTRY,  It  might  be  necessary 
to  dump  the  header  record  of  the  YES  Output  file. 

17.  Message: 

CASE  NUMBER  = n^^  OR  COUNTRY  = C^  FROM  THE  CAS  CUM 
OUTPUT  FILE  DOES  NOT  AGREE  WITH  INPUTS  ICASE  - n^ 
AND  CUNTRY  = C^. 

Meaning: 

On  a restart  run  the  case  number  and  country  of  the  CAS  Cum 
Output  file  must  agree  with  the  parameters  ICASE  and  CUNTRY 
. on  the  LEM  control  cards.  Possibly  the  wrong  file  has  been 
mounted,  or  the  wrong  values  have  been  specified  for  ICASE  and 
CUNTRY  on  the  LEM  control  cards. 

Remedy: 

Fatal  error  --  mount  the  proper  CAMS  Cum  file  or  specify  the 
proper  values  for  ICASE  and  CUNTRY.  It  might  be  necessary 
to  dump  the  header  record  of  the  CAMS  Cum  file. 
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18.  , Message: 

CASE  NUMBER  = OR  COUNTRY  = C^  FROM  THE  CAS 
DIST  OUTPUT  FILE  DOES  NOT  AGREE  WITH  INPUTS 
ICASE  = AND  CUNTRY  = 

Meaning: 

On  a restart  run  the  case  number  and  country  of  the  CAS 
Distribution  Output  file  must  agree  with  the  parameters  ICASE 
and  CUNTRY  on  the  LEM  control  cards.  Possibly  the  wrong 
file  has  been  mounted,  or  the  wrong  values  have  been  specified 
for  ICASE  and  CUNTRY  on  the  LEM  control  cards. 

Remedy:  ^ 

Fatal  error  --  mount  the  proper  CAS  Distribution  file  or  specify 
the  proper  values  for  ICASE  and  CUNTRY.  It  might  be  necessary 
to  dump  the  header  record  of  the  CAS  Distribution  file. 

19.  Message: 

IMPROPER  HEADER  LABEL  ON  FILE  filename. 

LABEL  = label. 

Meaning: 

The  file  label  specified  in  the 'first  two  words  of  the  header- 
record  of  the  file  "filename"  does  not  correspond  to  the  expected 
label.  Possibly  the  wrong  file  has  been  mounted. 

Remedy: 

Mount  the  proper  file.  It  might  be  necessary  to  dump  the  header 
record  of  the  designated  file. 

20.  Message: 

IMPROPER  LABEL  AND  SEQUENCE  NUMBER  ON  A LEM 
CONTROL  CARD.  LABEL  AND  SEQ.  NO.  = . 

Meaning: 

The  four  LEM  control  cards  are  supposed  to  have- LEM  Oi 
entered  in  Columns  75-80  (where  i = 1,  2,  3,  or  4).  Possibly 
the  control  cards  are  out  of  order. 
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Remedy: 

Be  sure  the  LEM  control  cards  are  in  the  proper  order  and 
that  the  label  and  sequence  numbers  are  entered  properly. 

21,  Message: 

ITERATION  NUMBER  NT  FROM  filename'  FILE  = n DOES 
NOT  AGREE  WITH  RSTART  = r FROM  LEM  CONTROL  CARD, 
where  filename  = CASCUM  or  CASDIS 

Meaning: 

The  iteration  number  NT  from  both  the  CAS  Cumulative  file 
(CASCUM)  and  the  CAS  Distribution  file  (CASDIS)  must  be  con- 
sistent with  the  value  of  RSTART  specified  on  the  LEM  control 
cards.  Possibly  the  wrong  file  has  been  specified  or  else 
RSTART  is  specified  incorrectly. 

Remedy: 

Fatal  error  — mount  the  proper  file  or  specify  the  correct  value 
for  RSTART. 
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5.3  PROCESSING  errors' 

• Each  of  the  modules  STG,  CAMS,  YES,  and  CAS  performs  its  own 
error  checking  during  execution.  The  error  messages  for  CAMS  and 
CAS  are  described  separately  in  the  problem  descriptioas  for  those 
modules.  The  error  messages  for  the  Segment  Truth  Generator  and  the 
YES  module  are  described  below. 

5.  3.  1 Processing  Errors  Detected  by  the  Segment  Truth  Generator 
1.  Message: 

THE  SEGMENT  ID  FILE  AND  THE  SUBSTRATA  HISTORICAL  FILE 
ARE  INCONSISTENT. 


SEGID 

SUB 

REGION 

rl 

r2 

ZONE 

zl 

z2 

STRATA 

si 

s2 

SUBSTRATA 

kl 

k2 

Meaning: 

The  region,  zone,  strata,  and/or  substrata  ID's  do  not  agree  between 
the  SEGID  file  and  the  SUBHST  file.  Perhaps  the  wrong  file  has  been 
specified  for  one  or  both  files.  This  error  message  was  intended 
primarily  for  checkout  purposes.  The  error  should  not  occur  during 
production  usage. 

Remedy: 

Non~fatal  error  — the  segment  from  the  SEGID  file  will  be  dropped 
and  execution  will  continue.  However,  the  user  should  check  both  files 
to  be  sure  the  proper  files  have  been  specified.  It  may  be  necessary 
to  dump  part  or  all  of  one  or  both  files, 

2.  ’ Message: 

SEGMENT  0-  IS  NOT  IN  IDSEG  FROM  SUBHST  FOR  REGION  r,  ZONE  z, 
STRATA  s,  SUBSTRATA  k 
SEGMENT  WILL  BE  DROPPED. 
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Meaning; 

The  indicated  segment  ID  CT  from  the  Segment  ID  file  was  not  found  in 
the  array  IDSEG  read  from  the  SUBHST  file.  Apparently  the  SEGID 
file  and  the  SUBHST  file  are  inconsistent. 

Remedy: 

Non-fatal  error  --  the  indicated  segment  will  be  ignored  and  execution 
will  proceed.  However,  the  user  should  check  both  files  to  be  sure  the 
proper  files  have  been  specified. 

Message; 

ERROR  RETURN  FROM  BETAD  ROUTINE. 

lER  = f . PWK  = PW,  SIGMA  = cr  PWKI  = PW.  '' 

k 1 


Meaning: 

An  error  return  from  the  Beta  Distribution  routine  has  occurred  in 
STG.  (See  the  writeup  of  BETAD  for  details.)  The  error  flag  f indicates 
the  nature  of  the  error. 


f = 1 
f = 2 


XBAR  = PWK  (X  = PWj^)  is  not  in  the  range  0 ^ X ^ 1, 
X was  reset  within  BETAD. 


cr  not  in. the  range 


0 ^ a ^ X 


1 -X 
X+  €■ 


where  € = 10 

Crwas  reset  within  BETAD. 


f = 3 Fatal,  error 

PW  . could  not  be  found  within  35  iterations. 

XI 


Remedy: 

If  lER  = 1 or  2,  the  error  is  non-fatal  and  the  program  .continues 
execution. 


If  lER  = 3,'  then  the  user  better  check  the  values  or  GV^  from  the 

SUBHST  file. 
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ERROR  RETURN  FROM  BE  TAD  ROUTINE. 

lER  = f . PMMEAN  = PM,  SIGMA  = a 

k 

Meaning: 

Similar  to  error  message  3 described  above  except  that  here- 
XBAR  = PMMEAN 
{X  = PMj^) 

Remedy: 

If  lER  = 1 or  2,  the  error  is  non-fatal  and  the  program  continues 
execution. 

If  lER  = 3,  then  the  user  should  check  the  values  PWj^,  DELTPM,  and 
CV^  from,  the  SUBHST  file. 

5.  Message: 

WARNING. . , NSEGS  = n . .NE,  NSEG 

(FROM  SUBHST)  = m 

SEGMENT  IDS  MAY  BE  INCORRECT. 

Meaning: 

The  number  of  segments  read  from  the  SEGID  file  does  not  agree  with 
NSEG,  the  number  of  segments  on  the  SUBHST  file.  Possibly  the  two 
files  are  inconsistent.  The  error  is  considered  to  be  non-fatal  by  the 
program,  but  the  error  may  be  quite  serious  and  the  results  should  be 
• regarded  with  suspicion. 

Remedy: 

Check  to  be  sure  the  SEGID  and  SUBHST  files  are  consistent.  It  might 
be  necessary  to  dump  all  or  part  of  both  files. 

6.  Message: 

WARNING.  . . NO  SEGMENTS  PROCESSED  BY  SEGMENT  TRUTH 
GENERATOR. 
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Meaning: 

For  some  reason  the  Segment  Truth  Generator  failed  to  process  any 
segments.  This  is  a very  degenerate  situation  and  should  not  normally 
be  encountered  in  production  runs.  The  most  likely  explanation  is  that 
all  of  the  substrata  processed  by  STGhad  zero-  segments. 

Remedy: 

Non-fatal  error  — however,  this  condition  will  probably  cause  an  abort 
in  CAMS.  Check  the  SUBHS  file.  Also  check  STARTR,  STARTZ,  ENDR, 
ENDZ. 
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Problem  Description  - CAMS 


1.  0 SCOPE 

1.  1 PROBLEM  CAPABILITIES 

The  CAMS  model  provides  an  estimate  of  the"proportion  wheat  in 
each  segment  selected  by  the  acquisition  program.  Up  to  four  estimates 
per  segment  are  given,  one  for  an  acquisition  date  in  each  of  four  crop 
windows.  It  gives  a Monte  Carlo  simulation  of  three  types  of  errors; 

1.  Crop  calendar  errors 

2.  Signature  extension  errors  (ordinary  segments) 

3.  Classification  errors  - an  error  category  including  crop 
calendar,  multi-temporal  sampling  effects,  and  input 
classification  errors  (training  segments) 

A fourth  type  of  error  modeled  is  multi- temporal  sampling  effects, 
which  remains  constant  during  a run.  A fifth  type  of  error  is  allowed 
by  the  choice  between  two  classification  models.  The  more  complex 
model  1 allows  for  mixed  crops,  and  includes  the  effect  of  omission 
and  commission  errors  - the  confusion -created  by  other  crops  growing 
in  the  area.  -Options  allow  the  omission  of  the  effects  of  each  type  of 
error. 

Since  the  signature  extension  error  is  not  well  understood,  CAMS 
allows  for  the  choice  of  either  an  additive  or  multiplicative  factor. 
Signature  extension  requires  acquisition  of  a training  segment  within  a 
fixed  period  preceding  the  ordinary  segment  acquisition.  If  this  con- 
dition is  not  met,  then  the  ordinary  segment  is  either  classified  as  a 
training  segment  or  not  classified  at  all.  The  option  desired  is  controlled 
by  user  input. 

CAMS-requires  five  input  files  and  some  card  input.  It  produces 
an  output  file  for  CAS  to  use  for  aggregation  of  the  wheat  area  estimates. 
On  option,  it  also  produces  a report  of  the  wheat  estimates,  and  on  option 
also,  a breakdown  of  the  error  factors. 
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1.  2 PROGRAM  DEVELOPMENT  AND  ORGANIZATION' 

CAMS  will  be  developed  in  FORTRAN  as  an  overlay  of  the  LEM 
program.  See  the  LEM  problem  description,  Section  1.2. 

1.3  OPERATIONAL  ASSUMPTIONS 

Scse  the  LEM  problem  description,  Section  1.3. 
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2.0  INPUT 

CAMS  requires  five  input  files  and  some  card  data, 

2.  1 CARDS 

Some  data  needed  by  CAMS  is  included  on  the  LEM  control  card 
See  LEM  problem  description,  Section  2.  1.  CAMS  also  requires: 

1.  A control  card,  specifying  options 

2.  A multi-temporal  matrix 

3.  Crop  calendar  error  coefficients 

Besides  the  LEM  card,  CAMS  requires  a total  of  13  cards,  which  must 
be  in  order.  See  Figure  4 for  the  deck  setup.  o 

2.  1.  1 List  of  Data  Quantities  and  Formats 

a.  LEM  control  card,  see  LEM  Section  2.  1.  Data  relevant  to 
CAMS  includes: 

ISEXT  Signature  extension  error  option,  = 0,  1 simulate  error 

= 2 bypass  error 

ISCC  Crop  calendar  error  option,  = 0,  1 simulate 

= 2 bypass 

ICLASS  Classification  error  option,  = 0,  1 simulate 

= 2 bypass 

lACQ  Acquisition  file  option,  = 0 include  file 

= 1 no  acquisition  file 

ICAMS  CAMS  error  option,  = 0,  1 simulate 

= 3 bypass  all  errors 

SEED2  Random  no.  seed  for  classification  error 

SEEDS  Random  no,  seed  for  signature  extension  error 

SEED4  Random  no.  seed  for  crop  calendar  error 

IPRCAM  Print  flag  for  CAMS  - this  controls  if  a report  is 
printed  - the  flag,  IREP,  on  the  CAMS  control 
card,  controls  what  is  printed. 


3 


28234-6029-RU-00 
Page  44 


b,  CAMS  control  card,  see  Figure  1 for  the  format  and  list  of 
quantities.  See  Figure  4 for  the  total  deck  setup. 

c.  Multi- temporal  sampling  matrix.  The  multi- temporal 
sampling  model  describes  the  effect  of  the  acquisition  of  a 

, sample  segment  in  more  than  one  bio-window.  There  are 
‘ 15  possible  non-zero  acquisition  states  for  a sample  segment. 

These  states  are  shown  below. 


W indow  s 
included 
Group  # 


1 

2 

0 

4| 

1,  2 

1,3 

1,4 

2,  3|2,4 

3,4 

1,  2,3 

1,2,4 

1,3,4 

2,3,4 

|l,  2,  3,4 

1 

2 

3 

4 

5 

6 

7 

8 9 

10 

11 

12 

.13 

14 

15 

The  effect  of  acquisition  conditions  corresponding  to  any 
particular  state  is  modeled  by  a weighting  factor,  M.  For 
ease  of  handling,  three  values  of  M are  chosen  as  program 
inputs  associated  with  groupings  of  the  15  acquisition  states. 

These  values  indicate  no  improvement  (M^  = 1),  small  improve- 
ment (M^  <1),  and  large  improvement  (M^  < M^)  in  the  accuracy 
of  classification  of  the  segment  with  a given  acquisition  state 
over  classification  in  the  present  window  (last  window  in  the  state  . 
definition)  alone. 

The  values  needed  are  which  M (Ml,  M2,  or  M3)  to  use  for  each 
of  the  15  groupings,,  and  the  values  of  M2  and  M3  (Ml  - 1).  Note 
that  by  definition,  for  group  no,  1,  2,  3,  and.  4,  Ml  = 1,  and 
Ml  = 1 >M2  >M3.  See  Figure  2 for  the  description. 

A total  of  eight  cards  are  needed  for  the  matrix,  each  with  the 
above  information,  since  the  acquisition  conditions  depend  on 
a.  wheat  type  - winter  or  spring,  b.  the  model  - 1 or  2 (model  1 
requires  three  cards,  one  for  wheat,  mixed,  and  other  components; 
model  2 requires  only  one  card).  See  Ffgure  4 for  the  order  and 
setup. 

If  model  1 is  being  used,  the  cards  for  model  2 must  be  present 
but  may  have  blank  fields  except  for  the  id  (CAMS)  and  sequence 
number,  and  vice  versa  if  model  2 is  being  used,  since  the  ^ 
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values  are  not  used.  If  data  for  both  v/inter  and  spring  is  not 
available,  the  data  may  be  left  blank  (except  id  and  sequence 
number),  but  the  cards  must  be  present,  and  if  CAMS  tries  to 
use  the  missing  data,  an  error  will  be  reported.  If  the  multi- 
temporal  error  bypass  is  specified  (IMULTI=1),  then  all  the 
cards  must  be  present  but  all  the  data  but  the  id  and  sequence 
number  may  be  left  blank. 

Crop  calendar  coefficients.  The  effect  of  crop  calendar  errors 
on  segment  classification,  particularly  in’ an  analytic  sense,  is 
not  well  established  at  this  time.  For  this  reason,  a simple 
generic  model  was  chosen  to  represent  this  effect.  This  model 
generates  a bias  (B)  and  standard  deviation  {(T)  from  a quadratic 
function  with  user  input  coefficients. 

B = (At)  + (At)^ 

cr  = (At)  + (At)^ 

The  value  of  the  coefficients  are  to  be  determined  from  off-line 
analysis,  curve  fitting,  etc,  , to  represent  the  observed  effects. 

The  values  for  Gl,  G2,  HI,  and  H2  are  needed.  See  Figure  3 
for  a description  of  the  quantities  and  format.  Model  1 requires 
these  four  values  for  the  three  components,  wheat,  mixed,  and 
other,  a total  of  12  values.  Model  2 requires  only  the  four  values, 
since  the  mixed  crop  effect  is  not  present.  Since  these  values 
may  be  different  for  winter  and  spring  wheat,  two  sets  must  be 
inputted.  Thus,  four  cards  are  always  needed: 

. 1.  Spring  wheat  - model  1 - 3x4  values 

2, '  Spring  wheat  - model  2-4  values 

3,  Winter  wheat  - model  1 - 3x4  values 

4,  Winter  wheat  - model  2-4  values 

If  model  1 is  used,  the  cards  for  model  2 must  be  present  but 
may  have  blank  fields  except  for  the  id,  CAMS,  and  sequence 
number,  and  vice  versa  for  model  2.  If  data  for  both  winter 
and  spring  is  not  available,  the  data  may  be  left  blank  except  for  id 
and  sequence  number,  but  the  cards  must  be  present,  and  if  CAMS 
needs  the  missing  data,  an  error  will  be  reported.  If  the  crop  calendar 
error  bypass  is  specified  (ISCC=2),  then  all  the  cards  must  still  be 
present,  but  all  the  id  and  sequence  number  fields  may  be  left  blank. 

See  Figure  4 for  the  full  CAMS  deck  setup.  . 

5 


28234-60E9-RU-00 
■Page  46 


2,  1,  2 Deck  Setup 

See  Figure  4.  CAMS  requires  13  card  inputs. 

2,  1.  4 Rules  for  Entering  Data 

■ See  LEM'  problem  description,  Section  2.1,4,  for  general  rules 
for  entering  data. 

2.  2 FILES 

CAMS  requires  five  input  files: 


1. 

CAMS  error  file  (CAMERR) 

from  SEE  program 

2. 

Segment  truth  file  (SEGTRU) 

intermediate  LEM  file 

3. 

Data  acquisition  file  (ACQUIS) 

from  SACS  program 

4. 

Crop  calendar  file  (CROPW) 

from  LUMP  program 

5. 

Signature  extension  file  (SIGEXT) 

from  SEE  program 

See  the  file  description,  Section  2.4  of  the  Users  Manual,-  for  the  formats 
and  contents.  If  certain  error  simulation  types  are  bypassed,  the  associated 
input  file  need  not  be  loaded.  See  Section  3‘.  3 for  a description  of  ail  the 
CAMS  error  control  flags  and. error  bypasses.  If  the  lACQ  flag  is  1 on  the 
LEM  control  card,  all  CAMS  error  simulation  is  bypassed,  and  only  the 
SEGTRU  and  CROPW  files  need  be  loaded.  If  the  crop  calendar  error  is 
bypassed  (ISCC=2),  the  CROPW  flag  file  need  not  be  loaded.  If  the  signa- 
ture extension  error  is  bypassed  (ISEXT=2),  the  SIGEXT  file  need  not  be 
loaded.  The  ICAMS  and  ICLASS  flags  can  cause  more  than  one  type  error 
to  be  bypassed  and  the  appropriate  associated  input  files  need  not  be  loaded. 
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Name 

Dimension 

Nominal 

Value 

Range 

Units 

Description 

IMOpEL 

1-2 

Flag 

= 1 
= 2 

use  model  1,  complex  model 
use  model  2,  simple  model 

IMULTI 

. 1 

0 

i 

0-1  • 

t 

Flag 

It 

o o 

include  multi-temporal  sampling  error 
bypass  multi-temporal  sampling  error 

ISIGEX 

1 

0 

1 

o 

Flag 

5^  0 
= 0 

use  multiplicative  model  of  signature  extension 
use  additive  model  of  signature  extension 

ISKIP 

• 0 

0-1 

Flag 

= 0 
^ 0 

skip  if  cannot  correlate  ordinary 

classify  as  training  with  training  segment 

ITMAX 

0-99 

Days  • 

Maximum  no.  of  days  between  training  and  ordinary  segment 
acquisition  dates  for  successful  correlation. 

IREP 

i 

0 

0-1 

Flag 

= 0 
^ 0 

include  error  breakdown  factors  in  estimate  report 
print  estimate  report  only 

IWIND 

4 

1-4 

From  which  window  to  take  the  probability  of  classifying  as  wheat 
given  mixed  to  calculate  the  proportion  of  pure  wheat  pixels:  if 

blank,  defaults  to  window  4.  This  qaantity  is  P(W  /M)  on  the 
CAMERR  input  file;  see  file  descriptions,  Section 

Input  Data  ~ CAMS  Control  Card  Format 


1 

2 

3 

4 

5 

7 

8 

IMODEL 

i 

IMULTI  1 

ISIGEX 

ISKIP 

ITMAX 

IREP 

IWIND 

11 

11 

11 

11 

12 

11 

11 

Figure  1.  Input  Data  - CAMS  Control  Card  Quantities 
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Nanae 

Dimension 

Nominal 

.Value 

Range 

Units 

Description 

IGROUP 

-15 

1-3 

Which, value  of  M to  use  for  each  acquisition  state,  see  2,  1.  1,  c.  , 
for  which  windows  are  in  each  state 

= 1 use  Ml  (-  1),  no  improvement 
= 2 use  M2,  small  improvement 

M2 

- 

C 

' . I 

,0<M2<l.i 

1 1 

0 

[ 

= 3 use  M3,  large  improvement 
Restriction:  IGROUP(l),  IGROUP(2),  IGROUP{3)  and  IGROUP(4) 
are  always  = 1,  by  definition,  and  so  need  not  be 
inputted. 

Value  of  M2,  small  improvement 

M3 

(! 

1 1 

1.  0<M3<1.  1 

I 

0 

Value  of  M3,  large  improvement 

ISEQ 

, 

2-9 

Restriction;  M3  < M2  < 1,  by  definition. 

Sequence  no.  - the  matrix  requires  eight  cards,  each  with  the 
same  format.  See  Deck-Setup,  Figure  4,  for  the  order  and 
description. 
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input  Data  - Multi-Temporal  Matrix  Format 
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Figure  2.  Input  Data  - Multi- Temporal  Matrix  Quantities 
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,Name 

Dimension 

l^ominal 
■ Value 

Range 

Units 

Description 

G1  • 

. 

+9.  999. 

Crop  calendar  error  coefficient 

G2 

• 

+99. 99 

Crop  calendar  error  coefficient 

HI 

±9.  999 

Crop  calendar  error  coefficient 

H2 

• 

+99. 99 

Crop  calendar  error  coefficient 

. ISEQ 

' 

10-13 

■ 

Sequence  number  - the  calendar  requires  four  cards.  See  Deck 
Setup,  Figure  4; 

Input  Data  - Crop  Calendar  Format 
Model  1: 


1 

7 

13 

19 

25 

26 

32 

38 

44 

50 

51 

57 

63 

69 

75 

79‘ 

O 

CNJ 

o 

f— 1 

OJ 

K 

1— < 

0 

(M 

X 

o 

CVl 

o 

i-*+ 

CO 

K 

C 

AMS 

a 

CO 

hO 

F6'.  3 

F6. 2 

F6. 3 

F6 

. 2 

F6.  3 

F6. 2 

F6.  3 

F6,  2 

F6.  3 

k 

F6 

.2 

F6.  3 

F6.  2 
J 

A4 

12 

vO 


Model  2: 
c.  c,  1 7 


wheat 


13 


•mixed 


other 


19  . 


1— t 

CO 

CN3 

0 • 

O 

F6.  3 F6.2  F6.3  F6;2 


Figure  3.  Input  Data  - Crop  Calendar  Coefficients  Quantities 
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3.0  PROCESSING 
3.  1 OVERVIEW 

/ 

See  Figure  5 for  an  overview  of  the  program  flow  in  CAMS,  CAMS 
operates  on  two  passes  through  the  acquisition  data.  The  training  seg- 
ments are  classified  on  the  first  pass  and  the  ordinary  segments  on  the 
second  pass.  The  flow  for  models  1 and  2 are  essentially  the  same,  but 
for  the  more  complex  model  1 the  error  factors  must  be  computed  for 
each  of  the  three  divisions,  wheat,  mixed,  and  other,  whereas  for  model  2 
this  breakdown  does  not  take  place.  A randorh  access  scratch  file  with  all 
the  training  segments  is  needed  to  figure  out  correlation  of  ordinary  with 
training  segments. 

3.  2 PROGRAM  FLOW 

See  Figure  6 for  a block  diagram  of  CAMS,  at  a more  detailed  level 
than  Figure  5.  It  shows  the  possible  options  .allowed  by  CAMS  through  its 
control  card.  The  subroutine  CAMSIN,  shown  in  Figure  5,  is  called  by 
LEM  to  read  in  the  CAMS  control  card,  multi- temporal  matrix,  and  crop 
calendar  coefficients,  which  are  passed  to  the  actual  CAMS  subprogram 
by  LEM  after  error  checking. 

3.  3 PROCEDURES  AND  EQUATIONS 

This  corresponds  to.  the  'Figure  6 flowchart.  It  specifies  all  the 
necessary  equations. 

CAMS  flow  can  be  broken  down  into: 

A.  Initialization 

B,  Pass  1 - training  segments 

1.  Compute  multi- temporal  effects 

2.  Compute  crop  calendar  errors 

3.  Compute  input  classification  and  total  classification 
error  (includes  1 and  2) 

-4.  Compute  PEST,  estimated  proportion  wheat 

5.  W rite  report 
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Figure  6.  CAMS  Logic  Flow  {Sheet  1 of  4) 
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Figure  6,  CAMS  Logic  Flow 
(Sheet  2 of  4) 
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3 ) PASS  2 - ORDINARY  SEGMENTS 


Figure  6.  CAMS  Logic  Flow  (Sheet  3 of  4) 
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Figure  6.  CAMS  Logic  Flow  (Sheet  4 of  4) 


28234-6029-RU-00 
Page  57 


C.  .Pass  2 - ordinary  segments 

1.  Correlate  with  training  segment 

2.  Compute  signature  extension  error  (includes  B.  3.  for 
associated,  training  segment) 

3.  Compute  PEST,  estimated  proportion  .wheat 
•4.  Write  report 

This  is  the  flow  of  Figure  5.  Figure  6 includes  the  complications  intro- 
duced by  options  to  bypass  error  effects,  summarized  below: 


Error  Type:  Flag: 

IMULTi! 

ISCC 

ICLAS.S 

ISEXT 

ICAMS 

1 

imodelI 

lACQ 

1.  Multi- temporal 

X 

X 

> 

X 

X 

2.  Crop  calendar 

X 

X 

X 

X 

3.  Input  classification 

X 

X 

X 

4.  Signature  extension 

X 

X 

X 

5.  Mixed  crops 

X 

X 

where  X means  error  effect  is  bypassed. 

If  a more  general  flag  is  on,  it  will  overrule  the  more  .specific  flags. 

All  flags  are  on  either  the  LEM  or  CAMS  control  cards.  The  IMODEL 
variable  is  not  a flag,  but  specifies  the  model  1 or  2,  but  specifying  model  2 
has  the  effect  of  bypassing  the  mixed  crop  effects.  What  these  mean,  applied 
to  the  equations,  will  be  spelled  out  later.  In  the  equations,  the  W,  M,  and  O 
stand  for  terms  associated  with  wheat,  mixed,  and  other.  For  model  2,  M 
and  O terms  are  zero.  Note  that  the  e.quations  are  presented  from  final  to 
start. 

B.  Pass  1.  - training  segment  acquisitions 
Bl.  Compute  PEST 

The  heart  of  this  pass  is  the  calculation  of  PEST,  the 
estimated  proportion  of  wheat: 

la.  PEST  = P(W)  « XI(W)  + P(M)  * XI(M)  + P(0)  * XI(0) 

where  P(W),  P(M),  and  P(0)  true  proportion  of  pure 

wheat,  mixed,-  and  pure 
other  pixels 
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The  total  error  would  then  be: 

lb.  PERR  = PEST  - PT(W) 

ic.  PfW)  = PT(W)  - PT(M)  * PW(M,  IWIND) 

PT(W),  PT(M)  from  SEGTRU  file 

Note:  If  put  of  range,  PT(M)  recomputed  as: 

If  PT(M)  * PW{M,IWIND)  < PT(M)  + PT(W)  - 100 
then  PT(M)  = (100  - PT(W)) /( 100  -PW(M,  IWIND) 

If  PT(M)  * PW(M,IW1ND)  > PT(W) 

, then  PT(M)  = PT(W)/PW(M,IWIND) 

PW  (M,  IWIND)  from  CAMERR  file 

IWIND  from  CAMS  control  card 

ld.  P(M)  = PT(M) 

le.  P(0)  = 100  - P(M)  - P{W) 

and  where  XI(W),  XI(M),  and  XI(0)  are  the  probability 
of  classifying  as  wheat,  given  wheat,  mixed,  or  other, 
and  includes  all  the  error  factors 

Compute  XL  (type)  - classification  error 

The  XIs  are  computed  by  first  computing  XRARS  and 
SIGMAS  and  then  getting  a random  number  from  a Beta 
distribution. 

2a.  CALL  BETA D (SEED{2),  XBAR  (TYPE),  SIGMA  (TYPE), 

XI  (TYPE),  O) 

where  SEED(2)  is  the  random  no.  seed  from  card  input 
for  classification  error 

TYPE  = W , M,  O - call  Betad  three  times 

2b.  SIGMA  (TYPE)  = PW  (TYPE,  WINDOW)  (TYPE)  =^'SIG  (TYPE) 

where  PW  from  CAMERR  file 

M rnulti- temporal  error  factor 

SIG  crop  calendar /input  classification  error 
factor  sigma 

WINDOW  which  window  current  acquisition 
date  in  = 1,  2,  3,  or  4 

2c..  XBAR  (TYPE)  = PW  (TYPE,  WINDOW)  =«=(1.  +M  (TYPE)  B (TYPE)) 

where  PW  same  as  above 

M same  as  above 

B crop  calendar /input  classification  error 
factor  bias 
18 
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Add  input  classification  errors 

3a.  B (TYPE)  = BERR  (TYPE,  WINDOW)  + BCG  (TYPE) 

•where  BERR  input  classification  error  bias 

from  CAM-ERR  file 

BCC  crop  calendar  error  bias 
3b..  SIG  (TYPE)  = 

SORT  (SIGERR  (TYPE,  WINDOW)  SIGERR  (TYPE,  WINDOW) 
+ SIGCC  (TYPE)  '^SIGCC  (TYPE)) 

where  SIGERR  input  classification  error  sigma 

from  CAMERR 

SIGCC  crop  calendar  error  sigma 

B3.  Compute  BCC  (TYPE),  SIGCC  (TYPE)  - crop  calendar  error. 
Compute  the  crop  calendar  error,  BCC  and  SIGCC: 

4a.  BCC  = G (TYPE,  SEASON,  1)  - DELTA  + 

G (TYPE,  SEASON.  2)  DELTA  * DELTA 

where  G from  card  input 

SEASON  winter  or  spring,  from  SEGTRU 

DELTA  difference  between  true  and  observed 
windows 

4b.  SIGCC  = ABS(H  (TYPE,  SEASON,  1)  DELTA  + 

H (TYPE,  SEASON,  2)  * DELTA  DELTA) 

where  H from  card  input 

SEASON  same  as  above 

DELTA  same  as  above 

4c.  DELTA  = (TSEG- TSTART)/(ENDSEG-BGNSEG+  1) 

4d.  TSTART  = ERR  (SEASON,  WINDOW) 

ERR  from  CROPW  file 

4e.  ENDSEG  = END  (SEASON,  WINDOW)  + TSEG 
BGNSEG=  START  (SEASON,  WINDOW)  + TSEG 
END,  START  from  CROPW  file 

Compute  TSEG  only  for  first  acquisition  in  each 
. window;  for  rest,  use  same  value. 

5a.  ITSEG  = RN-SD  (SEASON) 

SD  from  CROPW  file 
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5b.  CALL  BETAD{SEED{4),  0,  0,  RN,  1,  lER) 

SEED(4)  crop  calendar  seed,  from  card  input  returns 
RN  random  no,  from  normal  distribution 

B4.  Compute  M (TYPE).  - multi-temporal  matrix  error  factor. 

This  is  just  a table  lookup. 

6a.  M (TYPE)  = MS  (TYPE,  SEASON,  IWHATM) 

MS  ■ from  card  input 

6b.  IWHATM  = IGROUP  (TYPE,  SEASON,  ISTATE)  ' 

IGROUP  from  card  input 

6c.  ISTATE  = INDEX  (IWIN(i),  IWIN(2),  IWIN{3),  IWIN(4)) 

INDEX  local  ar'ray  set  up  to  yield  correct  value 

IWIN  local  array  calculated  in  CAMS  specifying  which 
windows  have  had  acquisitions  processed, 

= 1 no,  =2  yes 

These  are  all  the  equations  necessary  to  compute  PEST.  If  model  2 is  specified, 
TYPE=WHEAT  only  for  all  steps  .is  computed,  PW  (W,  WINDOW)  = PT(W) /iOO, 

and  also  la,  becomes  P(W)=100.  If  the  ICLASS  or  ICAMS  bypasses  are  specified, 
XI  (TYPE)  = PW  (TYPE,  WINDOW) 

where  PW  from  CAMERR  file  ' 

and  only  step  Bl.  needs  to  he  done.  If  IMULTI  bypass  is  specified,  step 
B4.  is  skipped  and  M (TYPE)  = 1.  If  ISCC  bypass  is  specified,  step  B3.  is 
skipped  and  BCC  (TYPE)  = , SIGCC  (TYPE)  = 0. 

The  acquisition  date  for  each  window  on  the  output  fi  .e  is  set  to  the 
first  acquisition  date  in  each  window  from  the  ACQUIS  file. 

Error  factors  must  be  calculated  and  saved  for  each  error  type  for 
the  error,  report,  if  necessary.  These  equations  are: 

For  total  error: 

lc.  TOT  = PERR 

ld.  V(TYPE)  = (XI  (TYPE)  - XBAR  (TYPE))  / 

_ ' (PW  (TYPE,  WINDOW)  - M (TYPE)) 


20 


28234-6029-RU-00 
Page  61 


ie.  ERTOT  (TYPE)  = M (TYPE)  ».(B  (-TYPE)  + V (TYPE))' 

lf.  ERBIAS  (TYPE)  =M  (TYPE)  (TYPE) 

lg.  ERRAND  (TYPE)  = M (TYPE)  *V  (TYPE) 

For  classification  error: 

2d.  CLTOT  (TYPE).=  B (TYPE)  + V (TYPE)  . 

2e.  CLBIAS  (TYPE)  = B (TYPE) 

2f.  CLRAND  (TYPE)  = V (TYPE) 

For  crop  calendar; 

5f.  DELTA 

5g.  CROPD  = TSEG  - TSTART 
For  multi-temporal: 

6d.  MULT  (TYPE)  = M (TYPE) 

C.  Pass  2 - ordinary  segments 
Cl.  Compute  PEST 

The  heart  of  this  pass  is  the  calculation  of  PEST,  the 
estimated  proportion  of  wheat.  The  equations  are  the 
same  as  for  B.  Pass  1,  la- Id.  However,  the  error 
factors  XI  are  computed  differently. 

C2.  Compute  XI  (TYPE)  - signature  extension  error 

The  XI' s are  again  computed  from  XBARs  and  SIGMAS, 
and  picking  a random  no,  from  a Beta  distribution. 

'2a.  CALL  BETAD  (SEED{3),  XBAR(TYPE),  SIGMA  (TYPE),, 
XI'. (TYPE),  O) 

where  SEED(3)  is  the  random  no.  seed  from  card  ■ 

input  for  signature  extension  error 

2b.  XBAR(TYPE)  = PW  (TYPE,  WINDOW)  - 

• (1.  + TERTOT  (TYPE) ZB  (TYPE,  1)  + ZB(TYPE,  2)) 

.where  PW  from  CAMERR  file 

TERTOT  from  training  segment  value  for 
ERTOT 

ZBs  from  SIGEXT  file 

ZB  (TYPE,  1)  = ZB  (TYPE,  1)  + 1 
- multiplicative  factor  is  increased 
by  1 from  value  on  SIGEXT  file 
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2c.  SIGMA  (TYPE)  =-PW  (TYPE,  WINDOW)  - 

AB-S  (TERTOT  (TYPE)  * ISIGEX  - ZSIG(TYPE,  1,  lUSE) 
+ (1  - ISIGEX)  -'=ZSIG  (TYPE,  2,  lUSE)) 

where  PW  from  CAMERR  file 

TERTOT  same  as  above 

ZSIG  . from  SIGEXT  file 

ISIGEX  from  card  input 

lUSE  calculated  during  correlation 

C3.  Compute  lUSE  - correlation  of  training  with  ordinary 
segment 

3a.  lUSE  = I of  IPRIOR(I),  I = 1,  6 for  training  segment 
which  was  ok;  if  none,  I = 7 ‘ 

where  IPRIOR  from  SEGTRU  file 

For  each  training  segment  until  good  one: 

3b.  Find  closest  training  acquisition  date  previous  to 
acquisition  date  of  ordinary  segment 

3c.  Subtract  the  two  and  check  against 

ITMAX  = max.  no.  of  days  from  card  input 

These  are  all  the  equations  needed  to  compute  PEST,  The  output  acquisition 
dates  are  from  the  ACQUIS  file.  If  model  2 is  specified,  TYPE  = WHEAT 
only  for  all  steps,  PW(W„  WINDOW)  = PT(W) /TOO,  and  also  la  becomes  P(W)  = 
100.  If  the  ISEXT  or  ICAMS  bypas.’ses  are  specified,  instead  of  B2  step,  do: 

XI  (TYPE)  = PW  (TYPE,  WINDOW)  * (1  + TERTOT  (TYPE)) 

where  PW  from  CAMERR  file 

TERTOT  . from  training  segment  value  for  ERTOT 

If  there  was  no  correlation,  the  segment  is  either  skipped  or  treated  just 
like  a training  segment  for  that  acquisition.  If  the  lAGQ  bypass  is  specified, 
PEST  = PT(W)  and  no  error  calculations  for  either  training  or  ordinary 
segments  are  done.  The  acquisition  date  on  the  output  fi-le  is  set-to  START 
.(WINDOW)  from  the  CROPW  file. 
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Error  factors  mast  be  calcalated  and  saved  for  each  error  type 
for  the  error  report,  if  necessary.  These  eqaations  are: 

Tor  total  error: 

lc.  TOT  = PERU 

where  PT(W)  from  SEGTRU  file 

ld.  SE  = PEST 

ld.  ALOCAL  = P(W)  ^=(1 -f  TERTOT(W))  ^-PWCW,  WINDQ-W)  + 

P(M)  ( 1 + TERTOT(M))  *PW(M,  WINDOW)  + 

P(0)  * (1  + TERTOT(O))  ^'PW(0,  WINDOW) 

le.  ERTOT  (TYPE)  = TERTOT  (TYPE)  * Z (TYPE,  1)  + Z (TYPE,  2) 

lf.  V (TYPE,  1)  =(XI(TYPE)  - XBAR(TYPE))/  ] 

(PW  (TYPE,  WINDOW)  =f=TERTOT  (TYPE))  ^ ^ 

V(TYPE,2)  = 0 - 

■ V (TYPE,  1)  = 0 , 

V (TYPE,  2)  = (XI  (TYPE)  - XBAR  (TYPE))  / 

PW  (TYPE,  WINDOW) 

Note:  If  SIGMA=0,  then  V(TYPE,  2)=0,  V(TYPE,  1)=0, 
and  no  calculation  done. 

lg.  ERBIAS  (TYPE)  = TM  (TYPE)  TB  (TYPE)  * ZB  (TYPE,  1) 

+ ZB(TYPE,  2) 

where  TM  and  TB  are  M and  B of  assoc,  training  segment 

lh.  ERRAND  (TYPE)  = TM  (TYPE) 

(TV (TYPE)  ^<ZB  (TYPE,  1)  + TB  (TYPE)  (TYPE,  1) 

+ TV  (TYPE)  (TYPE,  1))  +V  (TYPE,  2] 

where  TV  is  V from  assoc,  training  segment 

For  classification  error: 

2d.  CLTOT(TYPE)  = (TB  (TYPE)  + TV  (TYPE)) 

- Z(TYPE,  1)  + Z(TYPE,  2) 

2e.  CLBIAS(TYPE)  = TB  (TYPE)^ZB(TYPE,  1)+ZB(TYPE,  2) 

■ 2f.  CLRAND(TYPE)  =TV(TYPE)*ZB(TYPE,  1) 

+ TB  (TYPE)  *V  (TYPE,  1)  + TV  (TYPE)  ^^V  (TYPE.  1) 

+ V(TYPE,2) 
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For  signature  extension: 

2g,  Z (TYPE,  1)  = ZB  (TYPE,  1}  + V (TYPE,  1) 

2h.  Z (TYPE,  2)  = ZB  (TYPE,  2)  + V (TYPE,  2) 

For  training  segment; 

2i.  PID  = IPRIOR  (lUSE) 

2j.  TRAINA  = (PEST/ALOCAL)  100  ' 

2k.  TRAIND  = (PEST  - A LOCAL) /A  LOCAL  100 

Note:  If  ALOCAL  = 0,  TRAINA  = “ 

If  ALOCAL  = 0 and  PEST  = 0, 
TRAINA  = 100,  TRAIND  = 0. 

Again,  for  model  2,  TYPE  = WHEAT  only. 
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4.0  OUTPUT 
4.  1 PRINT  DATA 
4.  1.  1 Reports 

On  option,  CAMS  produces  a yield  estimate  report  which,  on  option, 
also  includes  a breakdov/n  of  the  error  factor's.  These  options  are  con- 
trolled by  the  IPRCAM  flag  on  the  LEM  control  card  and  the  IREP  flag  on 
the  CAMS  control  card. 

Figure  7 gives  the  layout  of  the  report.  The  report  is  divided  into 
two  parts,  for  training  and  ordinary  segments.  Section  3 gives  the  equations 
needed  for  each  category. 

4.  1.  2 Echo  Print  Input  Card  Images 

The  13  CAMS  input  cards  are  always  echo  printed.  Defaulted  or 
missing  data  will  appear  as  zeros. 

4.  2 FILES 

CAMS  outputs  one  output  file,  the  CAMS  output  file  (CAMSF),  .to  be 
used  by  CAS.  See  the  file  description.  Section  2.  4 of  the  Users  Manual  for 
the  format  and  contents. 
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COUNTRY  XXXX,  REGION  XX,  ZONE  XXX,  STRATA  XXX,  SUBSTRATA  XXXX-,  TRAINING  SEGMENT  XXXX 
TRUE  PROPORTION  WHEAT  = XXX.  XX 
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WHEAT  MIXED  OTHER  CAL. 


TOT  • (ERTOT)  (ERTOT)  (ERTOT)  (CLTOT)  (CLTOT)  (CLTOT)  (DELTA) 
BIAS  (ERBIAS)  (ERBIAS)  (ERBIAS)  (CLBIAS)  (CLBLAS)  (CLBIAS)  (CROPD) 
RAND  (ERRAND)  (ERRAND)  (ERRAND)  (CLRAND)  (CLRAND)(CLRAND) 

X.  XXXX  X.  XXXX  X.XXXX  .X.  XXXX  X,  XXXX  X.XXXX  .XX 


MULTI- 

TE.MP 

W (MULT) 
M (MULT) 
O (MULT) 

, XX  • 


If  only 

estimate 

report 

wanterl, 

froin(^ 

to  the  right 

omitted. 


COUNTRY  XXXX,  REGION  XX,  ZONE  XXX,  STRATA  XXX,  SUBSTRATA  XXXX,  ORDINARY  SEGMENT  XXXX 
TRUE  PROPORTION  V/HEAT  = XXX.  XX 


ACQDATE  ESTIM.  TOTAL 
MO/DY/YR  PROP.  ERROR, 


CROP  WINDOW 
XXXXXXXXXXXXXXXX  XX/XX/XX  . (PES) 


(TOT) 


ERROR 

WHEAT  MIXED  OTHER 


SIG.  EXT. 

WHEAT  MIXED  OTHER 


TRAIN  • 
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Z2 

SEG. 

w 

(Z) 

(Z) 

(TID) 

M 

(Z) 

(Z) 

(TRAINA) 

O 

(Z) 

(Z) 

(TRAIND) 

Note:  If  model  2,  MIXED  and  OTHER  quantities  will  appear  as  zeros. 


If  unable  to  correlate  ordinary  segment  acquisition  with  training  segment  and  so  treated  as  tr^ning  segment, 
TRAIN  SEG.  column  will  appear  as  out  of  range  (all  '(‘•s)  and  SIG.  EXT.  Z1  will  have  the  CROP  CAL  data,  and 
SIO.  EXT.  Z2  the  MULTI- TEMP  data. 


Figure  7.  CAMS  Estimate  and  Error  Reports 
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5.  0 ERROR  PROCESSING 
5,1  GENERAL 

See  the  LEM  problem  description,  Section  5.  1,  for  a summary  of 
overall  error  handling. 

5:2  INPUT  DATA  ERRORS 

1.  CAMS  XX  MODEL  NOT  1 OR  2 - X 

Fatal  error  - model  number  on  CAMS  control  card,  CAMS  01, 
is  not  1 or  2,  See  Figure  1. 

2.  CAMS  XX  ITMAX  NOT  BETWEEN  0 AND  99  - XX 

Fatal  error  - ITMAX  value  on  CAMS  control  card  bad.  See 
Figure  1. 

3.  CAMS  XX  IWIND  NOT  BETWEEN  0 AND  4 - X 

Fatal  error  - IWIND  value  bad  (note  that  l->4  good  values,  0 = 
default  value,  set  to  4)  on  CAMS  control  card.  See  Figure  1. 

4.  BAD  CAMS  ID  OR  SEQUENCE  NO.  - XXX  XX 

Fatal  error  - CAMS  control  cards  bad,  perhaps  out  of  order, 
or  missing  one.  See  Figure  4. 

5.  CAMS  XX  CROP  CALENDAR  COEF.  OUT  OF  RANGE  - XXXXX  ' 

Fatal  error  - ci*op  calendar  coefficient  should  te  between 
+9.  999  or  +99.  99.  See  Figure  3. 

6.  CAMS  XX  BAD  MULTI- TEMPORAL  MATRIX  VALUE  M(X)  - XXXX 

Fatal  error  - M2  hot  in  range  M3  ^ M2  < 1.  0 or  M3  not  in  range 
0 ^ M3  ^M2,  See  Figure  2, 

7.  CAMS  XX  BAD  MULTI- TEMPORAL  MATRIX  VALUE  IGROUP  (XX)’  - X 
Fatal  error  - IGROUP  value  not  1,  2,  or  3.  See  Figure  2. 
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5.  3 PROCESSING  ERRORS 

1.  CAMS  INPUT  TAPE  SEGTRU  - BEGINNING  REGION  AND  ZONE 
NOT  FOUND 

Fatal  error  - start  region  and  zone  specified  on  LEM  control 
card,  LEM  02,  is  not  present  in  file. 

2.  CAMS  INPUT  TAPE  SEGTRU  - ENDING  REGION  AND  ZONE 
NOT  FOUND 

Warning  - end  region  and  zone  were  not  found,  so  CAMS  processed 
all  records  until  EOF  (end-of-file). 

3.  CAMS  INPUT  TAPE  XXXX  - MISSING  RECORD 

Fatal  error  - input  tape  does  not  corr  elates  correctly  with  key 
tape  SEGTRU  - perhaps  wrong  file  mounted  for  SEGID  or  this 
input  tape. 

4.  BETA  DISTRIBUTION  ERROR  - FLAG  = X 

Warning  - Beta  distribution  subroutine,  BETAD,  returns  error 
for  mean  production  error: 

a.  FLAG  = 1 mean  not  in  range  0 ^ mean  ^ 1 so  if  mean  ^ 1, 

mean  set  to  1;  mean  < 0,  mean  set  to  0.  (mean  = 
XBAR  of  Equations  B2-2c.  , C2-2b.  in  Section 
3,3) 


3.  FLAG  = 2 sigma  not  in  range  0 ^ sigma  ^XBAR 
so  was  reset  within  BETAD.  ■ • 

c.  FLAG  = 3 the  random  number  could  not  be  found  within  35 

• - iterations  via  the  inverse  incomplete  Beta  function 

method,  so  XI  set  to  XBAR,  (See  Section  3,  3, 

B2  and  C2. ) 


1 - XBAR 
XBAR+  10 


-4 
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Problem  Description  for  the 
CAS  Program 


1.0  SCOPE 

Chis  document  describes  the  requirements  and  processing  logic 
for  the  CAS  Simulator  Module  of  the  LACIE  Error  Model  Program  (LEM), 
which  is  an  integral  part  of  the  Large  Area  Crop  Inventory  Experiment 
(LACIE)  system. 

1.  1 PROGRAM  CAPABILITIES 

The  purpose  of  the  CAS  Simulator  is  to  model  the  LACIE  aggrega- 
tion technique  including  the  aggregation  of  wheat  area  and  production  at 
the  stratum,  zone,  region,  and  country  levels  and  the  estimation  of  the 
accuracy  of  the  technique. 

. The  CAS  simulator  provides  the  following  functions: 

(1)  Calculate  area  and  production  estimates  and  standard 
statistics  at  the  stratum,  zone,  region,  and  country 
level. 

(2)  Calculate  the  estimated  confidence  level  associated 
with  the  90%  accuracy  criterion  at  the  country  level. 

(3)  Compute  the  mean  values  of  the  estimates,  errors,  and 
variances  of  area,  yield,  and  production  for  repetitive 
Monte  Carlo  trials. 

(4)  Calculate  the  true  simulation  confidence  level  associated 
with  the. 90%  accuracy  criterion  at  the  country  level  based 
on  the  statistics  of  repetitive  Monte  Carlo  trials. 

(5)  Output  the  CAS  summary  reports  and  CAS  Output  Files. 

The  CAS  aggregation  is  performed  at  various  prediction  intervals 
during  the  growing  season.  The  CAS  simulator  determines  the  present 
interval  and  obtains  the  appropriate’information  from  the  YES  and  CAMS 
output  files  and  the  Substrata  Historical  File. 
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CAS  processes  the  area  data  on  the  substrata  level.  The  substrata 
Group  No.  is  determined  in  order  to  determine'  the  proper  aggregation 
scheme.  Group  I substrata  parameters  are  computed  if  any  segments  have 
been  acquired  for  the  substratum,  otherwise  it  is  reassigned  to  Group  III. 
Group  II  parameters  are  computed  if  any  segment  has  been  acquired  in  the 
collection  of  ^roup  II- substrata  in  the  stratum,  otherwise  these  substrata' 
are  reassigned  to  Group  III.  Appropriate  historical  data  is  obtained  for  the 
Group  III  substrata. 

Once  the  appropriate  parameters  have  been  computed,  the  Group  I,  II, 
and  III  substrata  estimates  are  made  and  aggregated  to  the  stratum  level. 
Here  they  are  combined  to  give  the  total  stratum  estimate. 

The  variances  are  computed  for  each  group  and  aggregated  to  the 
stratum  level  and  combined.  Group  I and  Group  II  variances  use  a least 
squares  fit  of  the  historical  vs.  - estimate  data  for  the  stratum  as  part  of  the 
variance  computation.  In  order  to  compute  the  within- county  variance  esti- 
mates, all  of  the  substrata  (counties)  within  a zone  are  grouped  into  homo- 
geneous classes  and  the  within-class  variance  estimates  are  obtained  by  the 
least  squares  fit  and  then  used  for  the  within-county  variance  estimate. 

. The  strata  yield  data  from  the  YES  Output  File  is  combined  with  the 
area  data  to  determine  production.  Area  and  production  are  then  aggregated 
to  the  zone,  region,  and  country  levels.  Production  variance  is  also  com- 
puted and  aggregated  along  with  the  area  variance.  The  estimated  confidence 
level  is  computed  from  this  variance  data  and  the  mean  value  at  the  country 
level  for  area  and  production. 

The  simulation  also  keeps  track  of  the  error  between  the  LACIE 
estimate  and  the  true  value.  These  errors  are  computed  for  area,  yield, 
and  production  at  various  levels  of  aggregation.  During  successive  Monte 
Carlo  trials,  these  values  and  other  appropriate  parameters  are  accumulated 
to  enable  computation  of  the  simulation  mean  and  variance  of  each  parameter 
and  error  at  various  levels  of  aggregation.  The  Monte  Carlo  statistics  are 
used  to  compute  the  simulation  confidence  level  about  the  true  mean. 

The  results  of  the  simulation  are  output  in  the  CAS  summary  output 
reports.  The  data  is  also  maintained  on  the  CAMS  Cumulative  and  Distribu- 
tion Output  Files  for  further  processing  by  the  POUT  Output  Processor  if 
required. 
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i.  2 PROGRAM  DEVELOPMENT  AND  ORGANIZATION 

See" Section  1.  2 of  the  Problem  Description  for  the  LEM  program. 
1.  3 OPERATIONAL  ASSUMPTIONS 

See  Section  1.  3 of  .the  Problem  Description  for  the  LEM  program. 
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2.  0 INPUT 

One  control  card  set  and  three  input  files  are  required  as  inputs  to 
the  CAS  simulator.  The  control  card  set  specifies  parameters  and  flags 
which  control  the  execution  of  the  CAS  simulator. 

Data  files  are  used  to  input  data  to  CAS  from  the  YES  and  CAMS 
modules  within  LEM  and  from  the  LUMP  program. 

2,  1 CARD  INPUT  ’ 

Three  control  cards  are  required  by  the  CAS  simulator.  The  first 
contains  various  flags  and  parameters.  The  second  and  third  control 
cards  specify  the  prediction  dates  for  which  the  CAS  computations  are  to 
be  performed. 

2.  1.  1 List  of  Data  Quantities. 

See  the  Input  Data  Description  sheet  on  Page  5. 

2.  1.  2 Card  Formats 

Each  CAS  control  card  has  a fixed  field  format  as  shown  in  Figure  2.  1. 

”CAS"  is  entered  in  Columns  75-77  of  each  control  card,  and  a 
sequence  number  is  entered  in  Columns  79-80, 

2.  1.  3 Deck  Setup 

. Each  of  the  three  CAS  control  cards  is  required  (even  if  only  seven 
or  less  prediction  points  are  specified),  and  they  must  be  in  the  proper 
order.  Furthermore,  the  CAS  control  cards  must  follow  the  LEM  control 
cards  and  the  CAMS  control  cards  as  specified  in  Section  2.  1.  3 of  the 
Problem  Description  for  the  LEM  program. 

2.  1.  4 Rules  for  Entering  Data  on  Cards 

1,  Integers  must  be.  right  justified. 

2.  The  prediction  dates  must  be  entered  in  the  format 

7 .(312,  IX)  ■ 

with  a maximum  of  seven  dates  per  card. 


4 


INPUT  DATA  TCSCRIPTION 


I Name 


NHISTY 

H 

% * 

TOPT 


AUNITS 


DISTFF 


IWIND 


Dimension 


I 

1 

1 


Nominal 

Value 


Range 


1-20 

3-99 

0,1 


0,1 


0.1 


0,1 


Description 


( 


M =s  Number  of  historical  years  for  Group  III  ratio 
calculations.  (No  longer  used;  Set  = 1) 

H = Minimum  nuiii;jer  of  segments  required  for  applying 
regression  equation. 

T - option  flag: 

= 0 tosetT  = 0, 

= 1 to  calculate  T 

where  T is  the  second  term  of  the  variance  equation  for 

A • 

V 

2S’ 

Units  Option:  • - 

= 1 to  print  area  in  hectares  and  production  in  metric  tons, 
= 0 to  print  area  in  acres  and  production  in  bushels 

CAS  distribution  file  flag; 

= 0 to  generate  CAS  distribution  file, 

= 1 otherwise 

Prediction  bio-window  flags: 

IWIND(n)  = 1 to  process  bio-window  n, 

= 0 otherwise 


W PRIOR 


A PREP 
IPRD 


4 


1 

3, 14 


0 . 


0 


0. 


0-4 


Bio -window  priorities; 

last  of  bio -windows  in  decreasing  order  of  priority, 
e.  g. , 4,  1,  3,  2 or  . 

3,  1,  0,  0 


0,  1 


Print  option  for  area  and  production  summary  repoyt;, 
= 1 to  print  report, 

= 0 otherwise 


>64  year 
01-12  month 
1-31  day 


Prediction  dates  (up  to  14  dates): 

IPRD  (1,  n)  = year  - 1900 
IPRD  (2,  n)  = month 
IPRD  (3,  n)  = day 
The  prediction  dates  must  be  in  ascending  order.  The  first! 
zero  date  terminates  the  list.  ' I 
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76  79 


Card  1 


Card  2 


Card  3 


32X  A4  12 


312  312  312  312  312  312  312  25X  A4  12 


75  79 


312 


312 


312 


312 


312 


312 


312 


25X 


A4  12 


*X5 

P 

crq 

<D 

~4 

cr- 


Figure  2-1.  Data  Card  Formats 
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2.  2 INPUT  FILES 

The  foUov/ing  files  are  required  as  inputs  to  CAS, 

YES  Output  File  - Strata  yield  data  from  the  YES 

module 

Substra.ta  Historical  File  - Substrata  information  generated  by 

LUMP  - 

CAMS  Output  Data  - Segment  data  generated  by  the  CAMS 

module 

In  addition,  on  a restart  run  the  CAS  Cumulative  File  and  on  option,  the  CAS 
Distribution  run  must  be  input  since  the  data  on  those  files  is  accumulated 
over  all  Monte  Carlo  iterations. 
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3.0  PROCESSING 
3.  I OVERVIEW 

The  CAS  simulator  module  is  divided  into  two  major  subdivisions. 

The  first  subdivision  consists  of  two  subroutines,  CASIN  and  CASERl, 
which  process  the  CAS  control  cards  and  write- input  error  messages, 
respectively.  The  remaining  portion  of  CAS  executes  as  an  overlay  sub- 
program under  the  control  of  the  LEM  driver. 

3.  2 PROGRAM  FLOW 

Flow  diagrams  for  the  CAS  simulator  are  presented  in  Figures  3-1 
through  3-5.  Figure  3-1  is  an  overall  flow  chart  with  very  little  detail. 

It  represents  the  CAS  driver.  Figure  3-2  shows  the  detail  of  the  substrata 
classification  logic.  Figure  3-3  shows  the  detail  of  the  first  pass  CAS  logic, 
which  generates  data  sets  1-9  for  a given  bio-window  or  prediction  date. 
Figure  3-4  shows  the  detail  of  the  second  pass  logic,  which  computes  the 
area  variances  for  all  strata  with  acquired  segments.  Figure  3-5  shows 
the  detail  of  the  third  pass  CAS  logic,  which  generates  data  sets  10-17,  and 
19  for  the  same  bio-window  or  prediction  date. 

3.3  PROCEDURES  AND  EQUATIONS 

The  symbols  used  in  this  section  are  defined  in  Appendix  A.  The  data 
set  descriptions  are  given  in  Appendix  B.  The  equations  are  given  in 
Appendix  C.  - . ' 

As  seen  in  the  flow  diagrams,  the  CAS  logic  consists  of  the  following 

tasks: 

© Initialization 

e Determination  of  substrata  classes 
^ First  pass  calculations 
« Second  pass  calculations 
e Third  pass  calculations 
• Report  generation 

3.  3.  1 Initialization 

The  general  initialization  tasks  are  performed  by  subroutine  CASINT. 

1.  Rewinding  all  input  files 

2.  Initializing  flags  and  counters 
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3.  Determining  number  of  records  to  skip  on  files  YESOUT, 
CAMSF,  and  SUBHST  in  order  to  position  them  at  the 
proper  starting  region  and  zone  (STARTR  and  STARTZ). 

3.  3.  2 Determination  of  Substrata  Classes 

The  determination  of  the  substrata  classes  is  performed  in  subroutine 
CLASSN,  which  is  called  by  subroutine  CASPP  on  the  first  Monte  Carlo 
iteration  of  each  computer  run  for  each  bio -window  or  prediction  date. 

1.  Substrata  historical  data  is  read  from  either  the  SUBHST  file 
or  the  ISUBH2  file.  If  the  first  bio-window  or  prediction  point 
is  being  processed,  then  the  substrata  historical  file  SUBHST 
is  used.  Otherwise,  the  intermediate  substrata  historical  file 
ISUBH2  is  used. 

2.  Each  zone  in  the  country  is  processed  one  at  a time.  Within 
each  zone  the  collection  of  substrata  is  partitioned  into  one  or 
more  homogeneous  classes  of  substrata.  By  this  partitioning 
process  a class  number  is  assigned  to  each  substrata  in  the 
zone. 

3.  After  each  zone  is  partitioned  and  a class  number  is  assigned 
to  each  substrata  within  that  zone,  the  substrata  data  along  with 
the  assigned  class  number  is  written  back  onto  theTSUBHZ  file. 

4.  The  details  of  the  partitioning  process  are  given  in  the  writeup 
of  subroutine  CLASSN. 

3.  3.  3 First  Pass  Calculations 

The  first  pass  calculations  are  performed  in  subroutine  CASPP, 
which  is  called  for  each  bio -window  or  prediction  date. 

1,  Correctly  position  the  files  YESOUT,  CAMSF,  and  SUBHST 
at  the  proper  starting  region  and  zone, 

2.  Read  the  strata  yield  data  from  the  YESOUT  file. 

3.  Read  the  substrata  historical  data  from  the  SUBHST  file.-, 

4,  'The  substrata  group  number  is  examined  and  if  it  is  1 or  2, 
the  segment  data  is  read  from  the  CAMSF  file. 
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5.  Depending  upon  the  substrata  group  number,  the  segment 
data  is  aggregated  into  data  set  I or  2,  or  data  set  3 is 
generated. 

6.  Again  depending  upon-the  substrata  group  number,  the  sub-  ' 
strata  data  (data  set  1,  2,  or  3)  is  aggregated  into  data  set 
4,  5,  or  6. 

7.  If  no  Group  II  segments  are  acquired  in  the  strata,  then  data 
set  5 is  added  to  data  set  6 and  data  set  5 is  cleared  to  zero. 

8.  The  strata  data  in  data  sets  4,  5,  and  6 is  aggregated  into 
data  set  7 at  the  zone  level. 

• 

9.  The  zone  data  in  data  set  7 is  then  aggregated  into  data  set  8 
at  the  region  level. 

10.  The  region  data  in  data  set  8 is  aggregated  into  data  set  9 at 
the  country  level. 

3.  3.  4 Second  Pass  Calculations 

The  second  pass  calculations  are  performed  in  subroutine  CAS2,  which 
is  called  by  CASPP. 

1.  If  no  segments  were  obtained  for  the  entire  country,  the  message 
NO  ACQUISITIONS  IN  COUNTRY  is  printed  out  and  the  rest  of 
the  logic  is  skipped. 

2.  The  region,  zone,  strata,  and  substrata  pointers  for  the  direct 
access  files  CASDSF  and  ISUBH2  are  initialized. 

3.  The  next  record  (data  set  8)  from  file  CASDSF  is  read  into 
memory. 

4.  The  next  zone  record  (data  set  7)  from  file  CASDSF  is  read  into 
memory. 

5.  The  next  strata  record  (data  sets  4,  5,  6)  from  file  CASDSF  is 
read  into  memory.  . 

6.  ' The  next  substrata  record  from  file  ISUBH2  is  read  into  memory. 
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7, 


8. 


9. 


10. 


11. 

12. 


13. 


14. 


15. 


If  .the  substrata  class  number  is  zero,  if  there  are  less  than 
two  acquired  segments  in  the  zone,  or  if  there  are  no  acquired 
segments  in  the  strata,  then  the  rest  of  the  substrata  computa- 
tions are  skipped  (steps  8-10). 

Nest  the  group  number  is  tested.  If  it  is  3,  then  the  rest  of  the 
substrata  computations  are  skipped. 


If  the  group  number  is  2,  then  M_.,  the  number  of  acquired 
Group  II  segments  in  the  strata  is  tested.  If  it  is  zero,  then 
the  rest  of  the  substrata  computations  are  skipped.  If  M-.>0, 
then  the  computation  of  the  substrata  variance  multiplier  is 
completed  by  multiplying  VMUhTK  by  WA^g/M^j. 

If  the  group  number  is  1 or  2,  then  VMULTK  is  multiplied  by 
2 

S for  the  proper  substrata  class  and  the  result  is  added  to  the 
quantity  V1V2S  = + V^g. 

Steps  6-10  are  performed  for  each  substrata  in  the  stratum. 


After  ail  of  the  substrata  in  the  strata  are  processed,  M1K2KZ, 
the  number  of  acquired  segments  in  the  zone  is  examined.  If 
it  is  less  than  2,  then  steps  13-17  are  skipped.  If  M1K2KZ  ^ 2, 
then  the  number  of  acquired  segments  in  the  stratum  is  examined. 
If  there  are  no  acquired  segments  in  the  stratum,  then  steps  13-17 
are  skipped. 


The  term  T is  added  to  V1V2S  = V^g  + ^2S  2 

analytic  area  variance  ANVS2. 


The  quantity 


WA^g  + WA^g 


is  computed. 

2 

Finally,  the  area  variance  Vg  = Tg"'  + ^2S^  analytic 

area  variance  ANVARS  = Tg^  (ANVSl  + ANVS2)  are  computed 
- for  the  current  stratum,  which  has  at  least  one  acquired  segment. 
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16.  The  strata  record  (data  sets  4,5,  6)  is  then  written  back  onto 
the  CASDSF  file. 

17.  Also,  the  terms  are  added  to  the  sum 

ESTVZ  = S (V,„  + V,J 
zone 

and  the  terms  ANVSl  + ANVS2  are  added  to  the  sum 

ANALVZ  = S (ANVSl  + ANVS2) 
zone 

18.  If  there  were  no  acquired  segments  in  the  stratum  or  if  there 
were  less  than  two  acquired  segments  in  the  zone,  then  the 
historical  wheat  area  for  the  stratum  is  added  to  HWAZ3. 

19.  Steps  5-18  are  performed  for  each  stratum  in  the  zone.  When 
the  last  stratum  of  the  zone  has  been  processed,  the  zone  data 
record  (data  set  7)  is  written  back  onto  file  CASDSF. 

20.  Then  if  there  were  at  least  two  acquired  segments  in  the  zone, 
ESTVZ  is  added  to  ESTVR-  and  ANALVZ  is  added  to  ANALVR, 

21.  Steps  4-20  are  performed  for  each  zone  in  the  region. 

22.  If  there  were  any  zones  in  the  region  with  at  least  two  acquired 

segments,  then  the  region  data  record  (data  set  8)  is  written 

back  onto  the  CASDSF  file.  - 

/ 

23.  Also,  ESTVR  is  added  to  ESTVC  and  ANALVR  is  added  to 
ANAL  VC. 

24.  Steps  3-23  are  performed  for  each  region  in  the  country. 

25.  When  all  regions  have  been  processed,  control  is  returned 
back  to  subroutine  CASPP,  which  called  CAS2. 
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3,  3.  5 Third  Pass  Calcixlations 

The  third  pass  calculations  are  performed  in  subroutine  CAS3, 
which  is  called  by  CASPP. 

1.  If  no  segments  were  acquired  for  the  entire  country,  then  a 
return  to  CASPP  is  performed. 

2.  Data  from  the  zone,  region,  and  country  levels  (data  sets  7, 

8,  and  9)  is  combined  with  the'  strata  data  in  data  sets  4,  5 
and  6 to  generate  data  set  10  at  the  strata  level, 

3.  The  strata  data  in  data  set  10  is  aggregated  up  to  the  zone 
level  (data  set  11).  It  is  also  accumulated  in  data  set  14  of 
the  CAS  Cum  file  over  all  Monte  Carlo  iterations, 

4.  If  the  print  flag  is  set  (as  directed  by  the  LEM  input  parameter 
(IPE.CAS),  the  strata  portion  of  the  Area  and  Production  Sum- 
mary report  is  printed  out, 

5.  Next  the  zone  data  in  data  set  11  is  aggregated  up  to  the  region 
level  (data  set  12).  It  is  also  accumulated  in  data  set  15  of 
the  CAS  Cum  file  and  is  entered  into  the  CAS  Distribution  file 
(data  set  19). 

6.  If  the  print  flag  is  set,  the  zone  portion  of  the  Area  and  Pro- 
duction Summary  report  is  printed  out. 

7.  Then  the  region  data  in  data  set  12  is  aggregated  up  to  the 
country  level  (data  set  13).  It  is  also  accumulated  in  data 

set  15  of  the  CAS  Cum  file  and  is  entered  into  the  CAS  Distri- 
bution file  (data  set  19). 

8.  If  the  print  flag  is  set,  the  region  portion  of  the  Area  and 
Production  Summary  report  is  printed  out. 

i 

9.  Finally  the  country  data  in  data  set  13  is  accumulated  in  data 
set  17  of  the  CAS  Cum  file  and  is  entered  into  the  CAS  Distri- 
bution file  (data  set  i9)> 


10 
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10.  If  .the  print  flag  is  set,  then  the  country  data  for  this  bio- 
window or  prediction  date  is  saved  for  the  Country  Summary 
report  to  be  printed  after  all  bio-windows  and  prediction 
dates  have  been  processed, 

11.  Also  if  the  print  flag  is  set,  the  country  portion  of  the  Area 
and  Production  Summary  report  is  printed  out. 

3.  3.  6 Report  Generation 

The  Area  and  Production  Summary  report  is  printed  out  during  the 
second  pass  as  each  strata,  zone,  region,  and  country  is  processed. 

The  Country  Summary  report  is  printed  out  after  ail  bio -windows 
and  prediction  dates  have  been  processed. 
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Figure  3-2.  CLASSN  Flow  Diagram  (Sheet  2 of  4) 
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Figure  3-2.  CLiASSN  Flow  Diagram  (Sheet  4 of  4) 
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Figure  3~4.  CASZ  Flow  Diagram  (Sheefc  2 of  5) 
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Figure  3-4.  CAS2  Flow  Diagram  (Sheet  4 o£  5) 
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Figure  3-4,  CAS2  Flow  Diagram  (Sheet  5 of  5) 
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Figure.  3-5.  CASS  Flow  Diagram  (Sheet  4 of  4) 


28234-6029-RU-00 
Page  89 


4.0  OUTPUT 

4.  r PRINTED  DATA 

4.  1.  1 Printed  Reports 

Two  reports,  the  Area  and  Production  Summary  Report  and  the 
Country  Summary  Report,  may  be  generated  by  the  CAS  Simulator  under 
the  control  of  the  IPRCAS  parameter  on  the  DEM  control  cards  and  the 
APREP  parameter  on  the  CAS  control  cards.  If  APREP  = 1,  then  the 
Area  and  Production  Summary  Report  will  be  produced  on  each  iteration 
that  the  Country  Summary  Report  is  produced.  If  APREP  = 0,  then  the 
Area  and  Production  Report  will  not  be  generated  at  all.  The  Country 
Summary  Report  may  be  produced  on  each  Monte  Carlo  iteration,  on 
the  first  and  last  iterations  only,  on  the  last  iteration  only,  or  not  at  all, 
depending  upon  the  setting  of  the  IPRCAS  parameter  (see  Section  2.  1 of 
the  Problem  Description  for  the  LEM  Program). 

The  format  of  the  Area  and  Production  Summary  Report  is  shown 
in  Figure  4-1,  and  the  format  of  the  Country  Summary  Report  is  shown 
in  Figures  4-2  and  4-3. 

4.  1.  2 Intermediate  Debug 

At  the  present  there  is  no  Intermediate  Debugging  printout  specified. 
However,  during  checkout  the  contents  of  the  various  data  sets  will  be 
printed  out  as  they  are  generated. 

4,  1.  3 Status  Information 

During  the  execution  of  the  CAS  Simulator,  miscellaneous  status 
information  will  be  collected  and  passed  on  to  LEM  for  printing  out  at  the 
end  of  the  run.  In  particular,  the  number  of  records  read  from  the  Input 
Files  and  the  number  of  records  written  onto  the  CAS  Cumulative  Output 
File  and  the  CAS  Distribution  Output  File  will  be  saved  for  printing, 

4.  1.  4 Echo  Print  Input  Card  Images 

The  data  specified  on  the  CAS  control  cards  is  always  printed  out 
in  a forma.t  that’ is  almost  identical  to  the  format  on  the  input  card 
images.  Due  to  differences  in  the  FORTRAN  read  and  write  formats,  - 


19 


PROGRAMMEF^^OCUMENTAllST-_ r~777T^  T / a 

CM,  ,m,'; 


, , 5 . 5 « y . 3i  ’-b  •'  iiiii°  ’ ' " ' I ii^  ? 


95 

II 

to  > 


is 


cu  CO 

vD  I 
h-*  O' 
O 
tNJ 


itM  i ruJ^r  r^lhe 


WUUU 


I fU  ^ 

,op  'F^ 


^p>- 

: vo  I 


IV 

vO 

I 

i ■•§ 

I 

o 

o 


28234-6029 "RU -00 
Page  93 


the  printout  may  be  slightly  different  from  the  input  card  images.  For 
example,  a blank  field  will  be  printed  out  as  -0  rather  than  being  left 
blank. 

4.  2 FILES 

There  are  two  files  output  by  the  CAS -Simulator  --  the  CAS 
Cumulacive  Output  File,  which  consists  of  Data  Sets' 14,  15,  16,  and  17, 
and  the  CAS  Distribution  Output  File,  which  consists  of  Data  Set  19. 
Both  of  these  files  are  random  access  files.  The  formats  and  contents 
of  these  two  files  are  given  in  the  LACIE  File  Definition  Supplement. 
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5.  0 ERROR  PROCESSING 
5.  1 GENERAL 

The  program  will  attempt  to  find  as  many  errors  as  possible  during 
the  processing  of  the  input  control  cards.  The  program  will  continue 
checking  for  additional  input  errors  if,  any  input  error- is  detected.  There 
are  two  levels  of  error.  These  are: 

Level  1 - non-fa tal,  continue  processing. 

Level  2 - job  fatal.  Terminate  job  after  processing  all  input 
control  cards. 

When  a level  1 error  is  detected,  the  program  will  print  an  informative 
message  and  continue  processing.  When  a level  2 error  is  detected,  the 
program  will  print  an  informative  message,  set  a fatal  error  flag,  and 
continue  processing.  When  all  control  cards  have  been  processed,  the 
program  will  continue  executing  if  no  fatal  errors  were  found  or  will 
return  control  back  to  the  operating  system  if  at  least  one  fatal  error  is 
detected. 

The  errors  which  may  be  detected  by  the  CAS  Simulator  are 
described  below. 

5.  2 INPUT  ERRORS  DETECTED  BY  CAS 
1 . Message: 

IMPROPER  LABEL  AND  SEQUENCE  NUMBER  ON  A CAS  CONTROL 
CARD.  LABEL  AND  SEQ.  NO.  = 

Meaning : 

Fatal  error  --  the  three  CAS  control  cards  are  supposed  to  have 
CAS  Oi  entered  in  Columns  75-80  (where  i = 1,2,  or  3),  Possibly 
the  control  cards  are  out  of  order.  The  CAS  control  cards  must 
always  be  preceded  by  the  LEM  control  cards  and  the  CAMS  control 
cards,' 
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Remedy: 

Be  sure  that  the  LEM,  CAMS,  and  CAS  control  cards  are  all  present, 
and  are  in  the  proper  order.  Check  the  label  and  sequence  nunabers 
to  be  suie  they  are  entered  properly. 

2.  Message: 

NHIST  = m IS  OU  T OF  RANGE. 

(1  .LE.  NHIST  .LE.  20} 

Meaning: 

♦ 

Fatal  error  --  NHIST  must  satisfy  1 ^ NHIST  ^ 20  , 

Remedy: 

Change  the  input  value  of  NHIST  or  change  the  limits  of  NHIST  within 
the  CAS  Simulator  (subroutine  CASIN).  (No  longer  relevant.)’ 

3.  Message: 

HH  = h IS  OUT  OF  RANGE 
(3  .LE.  HH  .LE.  99  ) 

Meaning: 

Non-fatal  error  — HH  must  be  within  range 
3 ^ HH  :^99 

2 

in  order  to  apply  the  regression  relation  for  S . 

Remedy: 

Change  the  input  value  of  HH  or  change  the  limits  for  HH  within  the  CAS 

Simulator  (subroutine  CASIN).  The  program  will  set  HH  = 99999  so 

2 

that  the  first  formula  for  S^  will  always  be  used. 

4.  Message: 

ILLEGAL  WINDOW  SPECIFIED  IN  WPRIOR  = W^,  W^,  W3,  W^ 

(EACH  WINDOW  MUST  BE  1-4  OR  0) 
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Meaning: 

Fatal  error  --  an  improper  value  has  been  specified  for  one  or  more 
of  the  windows  in  the  array  WBRIOR,  The -only  allowable  values  are 
0,  1,  2,  3,  or  4. 

Remedy:  . 

Correct  the  offending  values. 

Message: 

ALL,  ENTRIES  IN  WPRIOR  ARE  ZERO 
Meaning: 

Fatal  error  --  each  entry  in  the  array  WPRIOR  is  zero,  but  at  least 
one  window  1-4  must  be  specified. 

Remedy: 

Specify  at  least  one  non-zero  window  number  in  the  array  WPRIOR. 
Message: 

ILLEGAL  PREDICTION  DATE  yy/mm/dd  SPECIFIED.  YEAR  = yy 
MUST  BE  . GE.  64,  MONTH  = mm  MUST  BE  1-12,  DAY  MUST  BE 
1-31 

Meaning: 

Fatal  error  --  an  illegal  prediction  date  has  been  specified  in  the 
array  IPRD.  The  prediction  date  must  satisfy 
year  ^ 64 
1 ^ month  ^12 
1 ^day  ^ 31 

Note:  Dates  such  as  Feb.  30  or  Sept,  31  will  be  accepted  by  the 

program  without  being  recognized  as  being  in  error. 

Remedy: 

Correct  the  offending  dates. 
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7o  Message; 

PREDICTION  DATES  NOT  IN  ASCENDING  ORDER  OR  DUPLICATES, 
Meaning: 

Fatal  error  --  the  prediction  dates  entered  in  the  irray  IPRD  must  be 
in  ascending  order  with  no  duplicates. 

Remedy: 

Enter  the  prediction  dates  in  ascending  order  and  eliminate  any 
duplicates. 

5.  3 PROCESSING  ERRORS  DETECTED  BY  CAS 

1,  Message: 

DIVISION  BY  ZERO  NOT  ALLOWED 
EQN.  (n),  symbol  = 0. 

Meaning; 

Fatal  error  --  the  program  detected  a zero  divisor  in  attempting  to, 
compute  equation  (n).  The  offending  zero  divisor  is  indicated 
symbolically  by  "symbol.  " 

Remedy: 

The  user  should  attempt  to  discover  why  the  indicated  quantity  was 
zero.  Usually  potential  zero  divisors  were  supposed  to  be  anticipated 
during  the  analysis  leading  to  the  coding  of  the  CAS  Simulator,  The 
program  logic  should  avoid  the  calculation  of  zero  divisors. 

2.  Me  s sage : 

IF  NT  = 1,  VARIANCE  ERRORS  AND  CONFIDENCE  LEVELS  CAN 
NOT  BE  COMPUTED  AND  WILL  ARBITRARILY  SET  TO  ZERO. 

Meaning: 

Non-fatal  error  --  on  the  first  Monte  Carlo  iteration  it  is  not  possible 
to  compute  the  variance  errors  VEA^,  VEP^,  and  VEY^  and  the 
confidence  levels  CLWA,  CLPRD',  etc.  These  values  will  arbitrarily 
set  to  zero. 

Remedy: 

Not  required. 
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3.  Message; 

STARTING  REGION  r . NOT  FOUND  ON  filename  FILE. 

st 

(where  filename  is  YESOUT,  SUBHST,  or  CAMSF) 

Meaning: 

Fatal  error  --  the  starting  region  r^^.  specified  by  STARTR  on  the 
CAS  control  cards  was  not  found  on  the  indicated  file.  Either 
STARTR  is  incorrect  or  something  is  wrong  with  the  indicated  file. 

-Remedy: 

Change  STARTR  or  mount  the  correct  file.  It  might  be  necessary 
to  dump  part  of  the  file  to  determine  the  starting  region  and  zone 
numbers.  ^ 

4.  Me  s sage: 

STARTING  ZONE  z , NOT  FOUND  ON  filename  FILE 

st 

(where  filename  is  YESOUT,  SUBHST,  or  CAMSF) 

Meaning: 

Fatal  error  --  the  starting  zone  z^^  specified  by  STARTZ  on  the 
CAS  control  cards  was  not  found  on  the  indicated  file.  Either 
, STARTZ  is  incorrect  or  sometliing  is  wrong  with  the  indicated  file. 

I 

- Reniedy: 

Change  STARTZ  or  mount  the  correct  file.  It  might  be  necessary  to 
dump  part  of  the  file  to  determine  the  starting  region  and  zone  numbers. 

5. '  Message: 

t 

ENDING  REGION  r , NOT  FOUND  ON  filename  FILE 

end 

• (where  filename  is  YESOUT,  SUBHST,  or  CAMSF) 

• Meaning: 

Non-fatal  error  --  the  ending  region  specified  by  ENDR  on  the 

CAS  control  cards  was  not  found  on  the  indicated  file.  Either  ENDR 
is-  incorrect  or  something  is  wrong  with  the  indicated  file.  The  pro- 
gram will  use  all  regions  up  to  the  end  of  data  on  the  file. 
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Remedy: 

• Change  ENDR.  Zero  is  a permissible  value  indicating  to  use  ail 
regions  up  to  the  end  of  data, 

6.  Message: 

' ENDING  ZONE  z , NOT  FOUND  ON  filename  FILE 

end 

(where  filename  is  YESOUT,  SUBHST,  or  CAMSF) 

- Meaning: 

Non~fatal  error  --  the  ending  zone  z specified  by  ENDZ  on  the 
CAS  control  cards  was  not  found  on  the  indicated  file.  Either  ENDZ 
is  incorrect  or  something  is  wrong  with  the  indicated  file.  The  pro- 
gram will  use  all  zones  up  to  the  end  of  the  last  region  or  the  region 
indicated  by  ENDR. 

Remedy: 

Change  ENDZ,  Zero  is  a permissible  value  indicating  to  use  all 
zones  of  the  final  region  (ENDR). 

7.  Message: 

ZERO  PREDICTION  DATES  ON  YESOUT  FILE  FOR  REGION  r, 

ZONE  z,  STRATUM  s (DATA  RECORD  n) 

Meaning; 

Fatal  error  --  all  six  prediction  dates  from  the  YESOl'T  file  are 
. zero  for  the  indicated  region,  zone,  and  stratum.  Thus  the  program 
cannot  determine  which  value  of  estimated  yield  to  use.  Something 
must  be  wrong  with  the  YESOUT  file. 

Remedy: 

Dump  out  part  of  the  YESOUT  file  to  check  the  prediction  dates  and 
yields.  In  particular  record  n+i  should  be  checked. 

8.  Message: 

ILLEGAL  GROUP  NUMBER  g FROM  SUBHST  FOR  REGION  r,  ZONE  z, 
STRATUM  s,  SUBSTRATUM  k (DATA  RECORD  n) 
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Meaning; 

Fatal  error  --  the  group  number  g from  the  n*'^  data  record  of  the 
Substrata  Historical  File  SUBHST  is  not  1,  2,  or  3,  indicating 
something  is  wrong  with  the  SUBHST  file. 

Remedy; 

Dmmp  out  the  n+1  record  of  file  SUBHST  to  check  the  group  number 
and  other  substrata  data. 

9.  Me  ssage; 

NAGR.  = n OR  NA  = m FROM  FILE  SUBHST  ARE  ZERO,  GROUP 
NUMBER  g IS  CHANGED  TO  3. 


Meaning; 

Non-fatal  error  --  one  or  both  of  the  quantities  NAGR  and  NA  from 
the  Substrata  Historical  File  are  zero.  Thus  the  group  number  g 
was  changed  to  3 by  the  CAS  Simulator. 

Remedy; 

The  input  to  the  LUMP  program,  which  generated  SUBHST.  If 
NAGR  or  NA  are  zero,  then  the  group  number  should  be  3. 


10.  Me  ssage; 

INCONSISTENCY  BETWEEN  YESOUT  AND  SUBHST  FILES. 

RECORD  REGION  ZONE  STRATA 
YESOUT  n^^  rj^  ®1 

SUBHST  n^  r,  ' z^  s^ 


Me  aning ; 

Fatal  error  --  the  region,  zone,  and  strata  from  the  YESOUT  and 
SUBHST  files  do  not  agree.  Agreement  was  supposed  to  be  assured 
by  the  YES  module. 
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Remedy: 

This  error  should  never  occur  in  production.  The  logic  of  the  YES 
and -CAS  modules  should  be  carefully  checked.  Also  it  might  be 
necessary  to  dump  portions  of  the  two  files. 

11.  ■ Message: 


INCONSISTENCY  BETWEEN  SUBHST  AND  CAMSF. 

RECORD 

REGION 

ZONE  STRATA 

SUBSTRATA 

SUBHST 

^1 

^1 

^1 

CAMSF 

^2 

‘ ^2 

^2  ®2 

^2 

Meaning: 

> 

Fatal  error  --  the  region,  zone,  strata,  and  substrata  from  the 
SUBHST  and  CAMSF  files  do  not  agree.  Agreement  should  have  been 
assured  by  the  CAMS  module.  Actually,  the  CAMS  module  uses  the 
CROPW  file  rather  than  SUBHST,  but  the  two  files  should  agree  with 
each  other  and  thus  witli  CAMSF. 

Remedy: 

This  error  should  never  occur  in  production.  The  logic  of  the  CAMS 
and  CAS  modules  should  be  carefully  checked.  Also,  it  might  be 
necessary  to -dump  portions  of  the  two  files. 

12,  Message:  • 

ERROR  RETURN  FROM  BETA  DISTRIBUTION  SUBROUTINE. 

ERROR  FLAG  = n. 

Meaning: 

Non-fatal  or  fatal  error,  depending  upon  error  flag  (see  writeup  of 
•BETAD  routine)  --an  error  was  detected  by  the  BETAD  subroutine 
while  CAS  was  attempting  to  compute  the  production  wheat 

for  the  most  recent  non-epoch  year  (eq.  (13)  in  CAS). 

The  meaning  of  the  error  flag  is  as  follows: 
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1. 

2. 


3. 


X not  within  range  0 ^1  so  was  reset  within  BETAD, 

Cr  not  within  range 


0 ^ X 


1 -X 


X+  e 
where  S'  = 10“'^ 
so  O’  was  reset  within  BETAD. 


Fatal  error.  The  random  number  could  not  be  found  within  35 
iterations  via  the  inverse  incomplete  Beta  function' method. 

X is  the  mean  value 


<y  is  the  standard  deviation 
cr  = CV^  4 

13.  Message: 


NO  SEGMENTS  IN  SUBSTRATA  k,  STRATA  s,  ZONE  z,  REGION  r 
(SUBHST  RECORD  n). 


Meaning: 

Fatal  error  --  the  program  detected  a group  I substrata  with  no 
segments.  Only  group  II  or  group  III  substrata  with  no  segments 
are  permitted. 


Remedy: 

Check  record  n+1  of  the  SUBHST  file  (in  particular  check  GRPNO  and 
NSEG).  This  error  should  never  occur  during  production. 

14.  Message: 

ZERO  OR  NEGATIVE  DIVISOR  IN  COMPUTING  TAU2A,  SIGM2S 
(EQS.  93D-93F) 


Meaning : 

Fatal  error  --  the  denominator  DENOM  = HWA12  + RN2{v)  (MYV12)^^^ 

2 2 

in  Eqns.  93d,  93e,  and  93f  in  the  calculation  of  Tg  and  (Tg  is  zero  or 
negative  (subroutine  DSIO).  This  probably  indicates  that  the  group  I,  II 
historical  wheat  area  and  the  multiyear  variance  are  zero.  The  pro- 
gram logic  should  never  reach  this  point  (see  message  15). 
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Remedy; 

Modify  the  input  to  the  LUMP  program  so  the  historical  wheat  area 
is  non-zero. 

15.  Message: 

WARNING.  . . HIST  PW  = PW  FOR  SUBSTRATA  k,  STRATA  s, 

■ ZONE  z,  REGION  r. 

GROUP  NO,  CHANGED  TO  3. 

Meaning ; . 

Non-fatal  --  the  program  will  not  accept  a group  I or  group  II  sub- 
strata with  a zero  {or  negative)  value  of  historical  PW  from  the 
SUBHSTfile  (see  eqns.  16,  33,  39,  46,  90,  93).-> 

Remedy: 

Non  required  the  program  will  automatically  change  the  group 
number  to  3 and  proceed.  The  user  may  wish  to  enter  a non-zero 
value  of  HIST  FW  in  the  LUMP  input  data. 

16,  Message: 

INPUT  PREDICTION  DATE  (m)'=  d 

.LT.  ALL  PREDICTION  DATES  ON  YESOUT  FILE  FOR  STRATA  s, 
ZONE  z,  REGION  r (RECORD  n). 

Meaning: 

til  til 

Non-fatal  r-  the  m Zulu  prediction  date  (obtained  from  the  m 

prediction  date  on  the  CAS  input  control  card  data)  is  less  than  all 

prediction  dates  on  the  YESOUT  file  for  the  indicated  stratum  on  the 

n*^^  YESOUT  data  record). 

Remedy: 

The  error  is  non-fatal.  The  program  will  drop  the  indicated  stratum 
and  proceed,  However,  the  user  may  wish  to  check  the  prediction 
dates  entered  on  the  CAS  control  cards. 
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17.  Message; 

■ TOO  MANY  MONTE  CARLO  ITERATIONS  FOR  THE  CAS  DISTRIBUTION 
FILE. 

Meaning ; 

Fatal  error  a maximum  of  100  Monte  Carlo  iterations  is  allowed, 
if  the  CAS  distribution  file  is  to  be  generated. 

Remedy: 

Specify  NTRIAL  ^ 100  in  the  LEM  control  card  data  or  specify  DISTFF  = 0 
in  the  CAS  control  card  data.  If  more  than  100  iterations  are  required 
and  if  the  CAS  distribution  file  is  desired,  then  the  dimensions  of  the 
arrays  CASDSB  and  BUFFR  in  common  block  /CASCNM/  may  have'  to  be 
increased.  Also  the  imutine  RWDISF  would  have  to  be  modified. 

18.  Message: 

SYMBOL  IN  EQ.  n = a 
REF.  VALUE  = b 

Meaning: 

Non-fatal  --in  subroutine  YSUB,  which  calculates  a quantity  Y,  the 
argument  a for  the  square  root  is  negative,  which  could  cause  trouble. 

To  avoid  the  problem,  the  program  resets 
a = 0,  if  a<0 
and  prints  a warning  if 

[aj  ^ b X lO"”^ 

Remedy: 

Non  required  — the  error  is  non-fatal,  and  execution  will  continue  with 
- 30 

a = 0 and  Y = lO"  . However,  if  [aj  is  significantly  large,  the  user 
should  investigate  why.- 

Note:  To  prevent  excessive  amounts  of  printout,  this  message  will  be 
printed  a maximum  of  five  times  per  iteration. 
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19«  Message: 

LESS  THAN  2 ACQUIRED  SEGMENTS  IN  CLASS  c OF  ZONE  z REGION  r 
NO.  OF  ACQ.  SEGMENTS  = n 

Meaning: 

Warning  -- -There' was  only  one  acquired  segment  in  the  indicated  class  c 

of  zone  z,  region  r.  Hence,  neither  the  regression  formula  nor  the 

2 

variance  formula  could  be  used  to  compute  S , the  within-class  estimated 
2 

area  variance,  S will  be  set  to  zero. 

Remedy: 

This  is  a non-fatal  error  and  there  probably  is  not  much  the  user  can  do 

2 

about  the  situation.  Execution  will  proceed  with  S set  to  zero  for  the 
indicated  class. 

20.  Message: 

EITHER  TOO  MANY  SUBSTRATA  OR  SEGMENTS  IN  REGION-NNNN 
ZONE-NNNN 

FATAL  ERRORS  IN  PASS  0 OF  CAS.  RUN  ABORTED. 

Meaning: 

Fatal  error  --  A maximum  of  300  substrata  or  300  acquired  segments 
are  allowed  in  a zone. 

Remedy: 

Reallocate  the  segments  so  that  tliere  are  not  so  many  in  any  one  zone 
or  increase  threshold  values  for  acquisition. 
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APPENDIX  A 
NOMENCLATURE 


A . 1 Introduction 

In  Section  A.  3 of  this  Appendix  are  listed  most  of  the  engineering 
symbols  used  in  the  CAS  Problem  Description.  In  order  to  shorten  the 
list,  only  the  primary  forms  of  many  of  the  symbols  are  given.  The 
conventions  described  below  may  be  used  to  distinguish  between  related 
forms  of  the  same  basic  symbol. 

Let  V be  an  arbitrary  quantity  (e.  g. , WA  for  wheat  area). 

Then  s 

V denotes  the  true  value; 

V denotes  the  historical  value; 

A 

V denotes  the  estimated  value; 

v^  denotes  the  value  for  level 

where 

= i for  a segment, 

= K for  a substrata, 

S for  a stratum, 

= Z for  a zone, 

-t  = R for  a region, 

1,-0  for  a country; 

V, » denotes  the  value  of  v for  Group  I segments  aggregated 
to  level  h, 

v-f  denotes  the  value  of  v for  Group  II  segments  aggregated 
to  level 

v^^  denotes  the' value  of  v for  Group  III  substrata  aggregated 
to  level 
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Thus,  for  example, 

A 

WA2S  denotes  the  estimated  wheat  area  for  Group  II  segments 
aggregated  up  to  the  strata  level, 

denotes  the  historical  proportion  of  wheat  at  the  substrata 
level, 

PRD^  denotes  the  estimated  production  of  wheat  at  the  zone  level. 
A.  2 Summation  Notation 

The  summation  notation  L is  used  extensively  in  the  CAS  Problem 
Description  to  indicate  aggregation  of  various  quantities  up  to  certain 
levels. 

Thus, 

K 

S denotes  aggregation  of  segments  up  to  the  substrata  level, 

1 

S 

S 

g denote  aggregation  up  to  the  strata  level, 

S 

i,K 

Z ] 

L f 

2 V denote  aggregation  up  to  the  zone  level, 

s i 

i.K  ) 

R 

L denotes  aggregation  up  to  the  region  level, 

C 

S denotes  aggregation  up  to  the  country  level, 

MIK 

L denotes  aggregation  of  Group  I segments  up  to  the  substrata 
i level, 

M2K 

denotes  aggregation  of  Group  II  segments  up  to  the  substrata 
i level, 

SI  • . • 

S .denotes  aggregation  of  Group  I segments  up  to  the  strata  level, 
i,K 
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51 

S denotes  aggregation  of  Group  I substrata  up  to  the  strata  level, 

52 

S denotes  aggregation  of  Group  II  segments  up  to  the  strata  level, 
i,K 

52 

S denotes  aggregation  of  Group  II  substrata  up  to  the  strata  level, 
K 

53 

S denotes  aggregation  of  Group  III  substrata  up  to  the  strata  level, 
K 

NT 

L denotes  accumulation  over  all  Monte  Carlo  iterations, 
dlass 

S denotes  summation  over  all  substrata  in  a class. 
i,K 

A.  3 Definition  of  Engineering  Symbols 


Data 


Symbol 

Set(s) 

Description 

1.  A 

— 

2 

Regression  coefficient  used  to  calculate  S . 

2.  (AREA)^ 

(SUBHST) 

Land  area  of  the  substratum. 

3.  AREAPS 

(Block 

Data) 

Area  per  segment. 

(Built-in  value  = 10289. 712  hectares) 

4.  B 

— 

2 

Regression  coefficient  used  to  calculate  S . 

5.  CL  WA 

(13) 

Confidence  level  about  the  estimated  WA. 

6.  CL  WA 

(True/Est. ) 

(13) 

Confidence  level  about  the  true  WA  using  the 
estimated  variance. 

7.  CL  WA 
(True/WC) 

(13) 

Confidence  level  about  the  true  WA  using  the 
within  county  variance. 

8.  CL  PRD 

(13) 

Confidence  level  about  the  estimated  production. 

9.  CL  PRD 
(True/Est. ) 

(13) 

Confidence  level  about  the  true  production  using 
the  estimated  variance. 

10.  CL  PRD 
(True/WC) 

(13) 

Confidence  level  about  the  true  production  using 
the  within  county  variance. 
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Symbol 

Data 

Set(s) 

Description 

11. 

(l)-.(6) 

and 

Number  of  Group  I substrata. 

(10)-(17) 

Number  of  Group  II  substrata. 

Number  of  Group  III  substrata, 

12. 

CVi 

• (SUBHST) 

Coefficient  of  variation  for  year-to-year 
change  in  PW, 

13. 

^^2 

(SUBHST) 

Coefficient  of  variation  for  within  county 
variation  of  PW. 

14. 

CV3 

Coefficient  of  variation  for  within  county 
variation  of  proportion  of  mixed  pixels. 

is. 

CV4 

Ratio  of  1964  Historical  WA  to  (1969)  Historical 
WA  (used  to  compute  T). 

16. 

. (7)  - (10) 

Ratio  of  estimated  group  1,  2 WA  to  historical 
group  1,2  WA. 

17. 

(10)-(17) 

Error  in  WA. 

18. 

(10) -(17) 

» 

Error  in  production. 

19. 

(10)-(17) 

Percent  error  in  yield. 

20. 

H 

(Input) 

Minimum  number  of  segments  required  for 
applying  S^  regression  equation. 

21. 

M 

(Input) 

Number  of  historical  years  for  Group  III  ratio 
calculation.  (No  longer  used) 

22. 

Ml. 

(4) 

Number  of  Group  I segments  at  strata  level. 

23. 

(1)-(17) 

Number  of  Group  I segments  which  have  been 
acquired. 

24. 

^2j 

(5) 

Number  of  Group  II  segments  at. strata  level. 

25. 

J^2^ 

{1)-(17) 

Number  of  Group  II  segments  which  have  been 
acquired. 

26. 

NA 

(SUBHST) 

Number  of  allocated  segments  in  the  substratum 
(from  Substrata  Historical  File). 
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Symbol 

Data 

Set(s) 

Description 

27.' 

Nr 

(SUBHST) 

Number  of  agricultural  segments  (NAGR  from 
Substrata  Historical  File). 

28. 

NT 

— 

Number  of  Monte  Carlo  iterations. 

29. 

PRD^ 

(10)-(17) 

Production. 

• 

0 

CO 

PW 

— 

Proportion  wheat. 

31. 

(l)-(7) 

Proportion  wheat. 

32. 

^^14  ■ 

(1),  (4) 

Proportion  of  wheat  for  Group  I segments. 

33. 

(2),  (5) 

Proportion  of  wheat  for  Group  II  segments. 

34. 

(PWj^) 

X 

— 

Proportion  wheat  for  segment  i and  substratum  K. 

35. 

P(X) 

— 

Analytic  function  used  to  compute  confidence 
levels. 

36. 

Q 

A 

Intermediate  quantity  used  to  calculate 

37. 

— 

A 

Intermediate  quantity  used  to  calculate  A^. 

38. 

RN 

— 

Random  number  used  to  compute  WA'^^. 

39. 

RNi(v) 

— 

z 

Random  number  used  to  compute  T . (No  longer  used) 

40. 

RN2(v) 

— 

2 

Random  number  used  to  compute  T . (No  longer  used) 

41. 

(7) 

A A 

Intermediate  factor  used  to  compute  V^^gand 
(within  county  area  variance). 

42. 

0 

— 

Computed  value  of  S^.' 

43. 

T 

(5) 

A 

Intermediate  factor  used  to  compute  ' 

44. 

A 

Estimated  Group  I area  variance. 

45. 

A 

^2-6 

— 

Estiniated  Group  II  area  variance. 

A A i;  , A A 

Note  Vii+V2i=  (^is  + Vjs)- 
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Data 

Symbol 

Set(s) 

Description 

46. 

VAR^ 

' (10)-(17) 

Area  variance. 

47. 

(10)-(17) 

Production  variance. 

48. 

(.10)~(17) 

Yield  variance. 

49. 

WA 

(1)-(17) 

Wheat  area. 

50, 

(i)-(n) 

Wheat  area. 

51. 

(I),  (4) 

Wheat  area  from  Group  I segments. 

52. 

(2),  (5) 

Wheat  area  from  Group  II  segments. 

53. 

WA3^ 

(3),  (6) 

Wheat  area  from'  Group  III  segments. 

54. 

wa-k 

(2) 

Most  recent  non-epoch  year. 

55. 

(7)-(10) 

Combined  wheat  area  from  Group  I and 
Group  II  segments. 

'56. 

(10)-(17) 

Yield. 

57. 

(10) 

True  yield  for  strata  (from  YES  Output  File). 

58, 

V 

__ 

2 2 

Year  index  used  in  computing  O’  and  T . (No  longer 

used) 

59. 

' 

Intermediate  quantities  used  to  compute  T. 

a-11  represent  the  same  set  of 

CL  IS.  x\ 

TTri 

quantities.  The  index  o:,  K,  or  K'  is  a 
dummy  index  used  to  distinguish  different 

substrata. 

60. 

I^K" 

Another  intermediate  quantity  used  to  compute  T. 
is  computed  by  a different  equation  than  1T^, 

’'k-  ’'k- 

61. 

or 

— 

standard  deviation  used  in  Beta  distribution. 

62. 

— 

A 

Intermediate  quantity  used  to  compute  VAR„. 
(No  longer  used)  ^ 

63. 

■ 

— 

A 

Intermediate  quantity  used  to  compute  VARg . 
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The  equations  within  each  data  set  are  listed  in  approximate  order  of 
computation. 

Data  Set  1 (Group  I Substrata) 


Program 

Symbol 

Engineer 

Symbol 

Equation 

Definition 

1. 

ISUBST 

Substrata  ID 

2. 

TWAK 

WAjjj 

(7) 

True  WA  (wheat  area) 

3. 

HWAK 

wAik 

(8) 

Historical  WA 

4. 

EWAK 

(9) 

Estimated  WA 

5. 

EPWK 

(2a) 

Sum  of  estimated 
(proportion  wheat) 

6. 

EPW2K 

(3a) 

S PW 

i 

7. 

MIK 

“iK 

No.  of  Group  I segments  which 
have  been  acquired 

8. 

.SMPKPI 

(4a) 

9. 

SUMPK2 

(5a) 

L PW^ 
i ^ 

10. 

SUMPK 

(6a) 

i 

11. 

CTIK 

CT^ 

Group  I flag: 

= 1 if  any  acquired  segments 
in  substrata, 

= 0 otherwise 

12. 

ANALVK 

(12) 

Group  I analytic  variance 

13. 

NCLASS 

Substrata  class  number 
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Data  Set  2 (Group  II  Substrata) 


Program 

Symbol 

Engineer 

Symbol 

Equation 

Definition 

X, 

ISUBST 

Substrata  ID 

2, 

TWAK 

^^2K 

(7) 

True  WA  (wheat  area) 

3. 

HWAK 

^^^2K 

(8) 

Historical  WA 

4. 

NEYWAK 

wa-k 

(14) 

Non-epoch  year  WA  (No  longer  used) 

5. 

EPWK 

^^2K 

(2b) 

Estimated  PW  (proportion 
wheat) 

6. 

EPW2K 

(3b) 

i 

7. 

M2K 

M^k 

No.  of  Group  II  segments  which 
have  been  acquired 

8, 

SMPKPI 

(4b) 

2 (PWj^)  (PW^.) 

9. 

SUMPK2 

(5b) 

L PW„^ 

i ^ . 

10. 

SUMPK 

(6b) 

S 

i ^ 

11. 

CT2K 

CT^ 

Group  II  flag: 

= 1 if  any  acquired  segments  in 
substrata, 

= 0 otherwise 

12. 

ANALVK 

(17) 

Group  II  Analytic  variance 

13. 

NCLASS 

Substrata  class  number 
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Program 

Symbol 

1.  ISUBST 

Z.  TWAK 

3.  HWAK 

.4.  CT3K 

Data 

Program 

Symbol 

1.  STRATA 

2.  TWASl 

3.  HWASl 

4.  EWASl 

5.  MIJS 

6.  CTIS 

7.  ANVSl 
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Data  Set  3 

(Group  ni  Sub 

strata) 

Engineer 

Symbol 

Equation 

Definition 

Substrata  ID 

WA3K 

(7) 

True  WA  (wheat  area) 

WA3K 

(8) 

Historical  WA 

CT3 

Group  III  flag: 

= 1 if  substrata  is  Group  III  or 

reclassified  as  Groap  III 


Set  4 (Group  1 Component  of  Strata  Data) 


Engineer 

Symbol 

Equation 

Definition 

Strata  ID 

^'^IS 

(19) 

True  WA  (wheat  area) 

WAjg 

(20) 

Historical  WA 

w'Ajg 

(21) 

Estimated  WA 

Mj. 

(22) 

Number  of  ac  quired  Group  I 
segments  in  strata 

(37) 

No.  of  Group  1 substrata  with 
acquired  segments 

(25) 

Group  I analytic  variance 
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Data  Set  5 (Group  II  Component  of  Strata  Data) 


• Program 
Symbol 

Engineer 

Symbol 

Equation 

Definition 

1. 

STRA  TA 

Strata  ID 

2. 

TWAS2 

(31) 

True  WA  {wheat  area) 

3. 

HWAS2 

WA^S 

(32) 

Historical  WA 

4. 

EWAS2 

^“^2S 

(33) 

Estimated  WA 

5. 

M2JS 

(34) 

Number  of  acquired  Group  II 
segments  in  strata 

6. 

CT2S 

(38) 

No.  of  Group  II  substrata  with 
acquired  segments 

7. 

T 

T 

(39) 

Second  term  in  variance 
equation  for 

8. 

ANVS2 

(40) 

Group  II  analytic  variance 

■9. 

P2IDPK 

f 

(46) 

S2 

v'  2i 

i,K  (PWj^). 
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Data  Set  6 (Groap  III  Component  of  Strata  Data) 


Program 

Symbol 

Engineer 

Symbol 

Equation 

Definition 

1. 

STRATA 

■ 

' 

Strata  ID 

2. 

TWAS3 

(47) 

True  WA  (wheat  area) 

3. 

HWAS3 

(48) 

Historical  WA 

4. 

CT3S 

No.  of  Group  III  substrata 

In  addition  to  Data  Sets  4,  5,  and  6,  the  following  strata -dependent  quantities 
need  to  be  written  on  an  intermediate  scratch  file  for  second  pass  processing; 


ys  = Y3  ^ 

ESTYS  = Yg 
EVYRS  = V^Rg  " 

VlV2S  = V^g+V^3= 
¥ARS  = V„ 

i O 


True  yield  for  strata 

Estimated  yield  for  strata 
Variance  of  yield  for  strata 

Estimated  group  1,  2 area  variance 
Estimated  area  variance  for  strata 


ANVARS 


= Estimated  analytic  area  variance  for  strata 
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Data  Set  7 (At  Zone  Level) 


Program 

Symbol 

Engineer 

Symbol 

Equation 

Definition 

1. 

ZONE 

Zone  ID 

2. 

TWAZ 

WA^ 

(56) 

True  WA  (wheat  a.rea) 
(Also  in  Data  Set  11) 

3. 

HWAZ2 

(■57) 

Group  1,2  hJ.storical  WA 
(if  M1K2KZ  S 2)  . 

4.- 

EZ 

(63)  ‘ 

5. 

M1-K2KZ 

(49) 

6, 

ANALVZ 

(69) 

Group  1,  2 analytic  area  variance 

7. 

NSTRAZ 

No.  of  strata  in  zone 

8. 

HWAZl 

(61) 

Group  1,  2 historical  WA 
(if  MiK2KZ  ^ 1) 

9. 

EWAZl 

(62) 

Group  1,  2 estimated  WA 
(if  M:1K2KZ  S:  1) 

10. 

HWAZ3 

(68) 

Total  historical  wheat  area  for 
all  strata  in  zone  without  acquired 
segments 

11, 

ESTVZ 

(59) 

Group  1,  2 variance  estimate 

12. 

13. 

HWAZ12 

M1K2CL 

(93a) 

(50) 

Group  1,  2 historical  WA 
o Obtained  from  zone  level 
if  M1K2KZ  S2; 
o HWAR12  at  region  level 
if  M1K2KZ  <2 
class 

S (M,^  + M_^)  = number  of 
K IK  2K 

acquired  segments  in  class 

14. 

EPWCL 

(51) 

class  ^ 

S (PW,.  + FW_.) 
i.K  ^ 

15. 

EPW2CL 

(52) 

class  A 9 A 0 

S 

i,K 
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Program 

Symbol 

Engineer 

Symbol 

Equation 

Definition 

17. 

PKPICL 

(53) 

class  ^ 

L FW^  (PW,.  + PW-.) 
. K ' li  2r 

1,  K 

18. 

PK2CL 

(54) 

class  ^ o class  ^ ^ 

1,  K K • 

19. 

PKCL 

(55) 

class  ^ class  ~ 

S PWj^=S  (Mik+M^j^) 

1,  K K 

Data  Set  8 (At  Region 

Level) 

Program 

Symbol 

Engineer 

Symbol 

Equation 

Definition 

1. 

REGION 

Region  ID 

2. 

TWAR 

WAr 

(70) 

True  WA  (wheat  area) 
(also  in  Data  Set  12) 

3. 

HWAR2 

(WA  ) 

R 

(71) 

Group  1,  2 historical  WA 

4. 

ER 

®R 

(77) 

■ 5. 

’M1K2KR 

{ 

(78) 

^ ^^IK  ^2K^ 

6. 

ANALVR 

(79) 

Group  1,2  analytic  area  variance 

7. 

NZONES 

No.  of  zones  in  region 

8. 

HWARl 

(WA  ) 

-l-j  ^ R 

(75) 

Group  1,  2 historical  WA 

• 9. 

EWARl 

(76) 

Group  1,  2 estimated  WA‘ 

10. 

ESTVR 

(73) 

Group  1,  2 estimated  variance 

11. 

M1M2ZR 

Group  1,  2 flag: 

= 0 if  M1K2KZ  <2  for  all  zones 
in  region 

= 1 if  M1K2KZS  2 for  any  zone 
in  region  (i,  e, , if  any  zone 
has  at  least  two  group  1,  2 
segments) 
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Data  Set  9 (At  Country  Level) 


Program 

Symbol 

Engineer 

Symbol 

Equation 

Definition 

1. 

COUNTR 

Country  ID 

2. 

TW  AC 

WAc 

(80) 

True  WA  (wheat  area) 
(Also  in  Data  Set  13) 

3. 

HWAC2 

(81) 

Group  1,  2 historical  WA 

4. 

EC 

(87) 

5. 

M1K2ZC 

(88) 

6. 

ANALVC 

(89) 

Group  1,  2 analytic  area  variance 

n 

t « 

M1M2FC 

Group  1,  2 flag: 

= 0 if  M1K2KZ  <2  for  all  zones 
in  country 

= 1 if  M1K2KZ  ^ 2 for  any  zone 
in  country  (i.  e.  , if  any  zone 
has  at  least  two  group  1,  2 
segments) 

8. 

HWACl 

r 

{ 

CWA,  ) 
i,  ^ C 

(85) 

Group  1, 2 historical  WA 

■ 9. 

EWACl 

(86) 

Group  1,  2 estimated  WA 

10. 

ESTVC 

(83) 

Group  Ij  2 estimated  variance 
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Data  Set  10  (At  Strata  Level  - Part  2 Processing) 
Note:  Perform  only  if  M1K2KC  ^ 2 


Program 
• Symbol 

Engineer 

Symbol 

Equation 

Definition 

1. 

HWAS 

WAg 

(94) 

Historical-  WA 

2. 

TWAS 

WAg 

(95) 

True  WA 

3. 

EWAS 

WAg 

(96) 

Estimated  WA 

4. 

A ERRS 

EAg 

(97) 

Area  error 

5. 

AVARS 

. VARg 

(92b,  93c) 

Area  variance 

6. 

TPRODS 

PRDg 

(99) 

True  production 

7. 

EPRODS 

PADg 

(100) 

Estimated  production 

8. 

PRERRS 

^^S 

(101) 

Production  error 

9. 

PRVARS 

vl>Rs 

(102) 

Production  variance 

10. 

TERRS 

(103) 

Yield  error 

11. 

ANAVS 

(92c,  93d) 

Analytic  area  variance 

12. 

ANPRVS 

(105) 

Analytic  production  variance 

13. 

ES 

^S 

(90) 
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Data  Set  II  (At  Zone  Level  - Part  2 Processing) 


Program 

Symbol 

Engineer 

Symbol 

Equation 

Definition 

1. 

HWAZ 

WAz 

(106) 

Histor  veal  WA 

2. 

TWAZ 

WAz 

(107) 

True  WA 

3. 

EWAZ 

(108) 

Estimated  WA 

4. 

AERRZ 

®^Z 

(109) 

Area  error 

5. 

AVARZ 

vIrz 

(iro) 

Area  variance 

6. 

TPRODZ 

PRDz 

(111) 

True  production 

7. 

EPRODZ 

PRDz 

(112) 

Estimated  production 

8. 

PRERRZ 

^^Z 

(113) 

Production  error 

9. 

PRVARZ 

v:^Rz- 

(114) 

Production  \^riance 

lo: 

TYZ 

Y 

z 

(il5) 

True  yield 

11. 

EYZ 

A 

^z 

(116) 

Estimated  yield 

12, 

YERRZ 

(117) 

Yield  error 

13. 

MiZ 

^IZ 

(118) 

Number  of  acquired  Group  I 
segments  in  zone 

14, 

M2Z 

^2Z 

(119) 

Number  of  acquired  Group  II 
segments  in  zone 

15, 

CTIZ 

c^iz 

(120) 

Number  of  Group  I' sub  strata 
with  acquired  segments 

16, 

CT2Z 

C^2Z 

(121) 

Number  of  Group  II  substrata 
with  acquired  segments 

17. 

CT3Z 

^^3Z 

'(122) 

Number  of  Group  III  substrata 
with  acquired  segments 

18, 

ANAVZ 

(123) 

Analytic  area  variance 

19. 

ANPRVZ 

(124) 

Analytic  production  variance 
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.Data 

Set  12  (At  Region 

Level 

- Part  2 Processing) 

Program 

Symbol. 

Engineer 

Symbol 

Equation  Definition 

1. 

HWAR 

WA^ 

(125) 

Historical  WA 

2. 

WAR 

WAj, 

(126) 

True  WA 

3. 

EWAR 

w'Aj^ 

(127) 

Estimated  WA 

4. 

AERRR 

(128) 

Area  error 

5. 

AVARR 

vAr^ 

(129) 

Area  variance 

6. 

TPRODR 

PRD^ 

(130) 

True  production 

7, 

EPRODR 

pAdr 

(131) 

Estimated  production 

8. 

PRERRR 

^Pr 

(132) 

Production  error 

9. 

PRVARR 

V^Rr 

(133) 

Production  variance 

10. 

TYR 

^R 

(134) 

True  yield 

11. 

EYR 

A 

^R 

(135) 

Estimated  yield' 

12, 

YERRR 

(136) 

Yield  error 

13. 

MIR 

^IR 

(137) 

Number  of  acquired  Group  I 
segments  in  region 

14. 

M2R 

^2R 

(138) 

Number  of  acquired  Group  II 
segments  in  region 

15. 

CTIR 

^"^IR 

(139) 

Number  of  Group  I substrata 
with  acquired  segments 

16. 

CT2R 

C^2R 

(140) 

Number  of  Group  II  substrata 
with  acquired  segments 

17. 

CT3R 

^^3R 

(141) 

Number  of  Group  III  substrata 
with  acquired  segments 

18. 

ANAVR 

(142) 

Analytic  area  variance 

19. 

ANPRVR 

(143) 

Analytic  production  variance 
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Data  Set 

: 13  (At  Country  Level  - 

Part  2 Processing) 

Program 

Symbol 

Engineer 

Symbol 

Equation 

Definition 

1, 

HWAC 

WA^ 

(144) 

Historical  WA 

,2, 

TWAC 

WAc 

(145) 

True  WA 

3. 

EWAC 

A 

WA^ 

(146) 

Estimated  WA 

4. 

AERRC 

EAc 

(147)  • 

Area  error 

5. 

AVARC 

VAR^ 

(148) 

Area  variance 

6. 

TPRODC 

PRDc 

(149) 

True  production 

7. 

EPRODC 

PRDc 

(150) 

Estimated  production 

'8. 

PRERRC 

EPc 

(151) 

Production  error 

9.. 

PRVARC 

VPRc 

(152) 

Production  variance 

10, 

TYC 

Y 

C 

(153) 

True  yield 

11. 

EYC 

A 

Y 

C 

(154) 

Estimated  yield 

12. 

YERRC 

(155) 

Yield  error 

13, 

MIC' 

“ic 

(156) 

Number  o..’  acquired  Group  I 
segments  in  country 

14. 

M2C 

“zc 

(157) 

Number  of  acquired  Group  II 
segments  in  country 

15. 

CTIC 

(158) 

Number  of  Group  I substrata 
with  acquired  segments 

16. 

CT2C 

CTic 

(159) 

Number  of  Group  II  substrata 
with  acquired  segments 

17. 

CT3C 

<=^3C 

(160) 

Number  of  Group  III  substrata 
with  acquired  segments 

18. 

ANAVC 

(161) 

Analytic,  area  variance 

19. 

ANPRVC 

(162) 

Analytic  production  variance 
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Program 

Symbol 

Engineer 

Symbol 

Equation 

Definition 

20, 

CLEWA 

CL  WA 

(163) 

Confidence  level  about  estimated 
WA  using  estimated  variance 

21. 

CLEPRD 

CL-PRD 

(165) 

Confidence  level  about  estimated 
production  using  estimated 
variance 

22. 

CLATEC 

CL  WA 
(True/est) 

(166) 

Confidence  level  about  true  WA 
using  estimated  variance 

23. 

CL.PTEC 

CL  PRD 
(True/est) 

(167) 

Confidence  level  about  true 
production  using  estimated 
variance 

24. 

CLATWC 

■ CL  WA 
(True/wC) 

(168) 

Confidence  level  about  true  WA 
using  within  county  variance 

25, 

CEPTWC 

CL  PRD 
(True/w'G) 

(169) 

Confidence  level  about  true 
production  using  within  county 
variance 

Data  Sets  14,  15,  16,  and  17  are  similar  to  Data  Sets  10,  11,  12 
and  13  with  a few  important  exceptions: 

1)  Data  Sets  10-13  are  for  only  one  Monte  Carlo  iteration, 

• whereas  Data  Sets  14-17  represent  the  sums  of  the  values 
accumulated  over  all  Monte  Carlo  iterations.  These 
accumulated  values  will  be  used  to  compute  and  print  out  • 
average  values. 

2)  Data  Sets  14-17  are  written  onto  the  CAS  Cumulative  File. 

3)  The  sums  of  the  squares  of  the  errors  are  added  to  Data 
Sets  14-17. 

Thus  the  additional  quantities  for  Data  Sets  14-17  are  as  follows:' 
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Data  Set  14  (At  Strata  Level) 


Program 

Engineer 

Symbol 

Symbol 

NT 

Equation 

Definition 

1. 

SQAES.S 

• S'(EAg)'^ 

(170) 

Sum  of  the  squares  of  the  area 

errors 

• NT 

2. 

SQPERS 

- S (EPg)^ 

(171) 

Sum  of  the  squai*es  of  the 
production  errors 

NT 

3. 

SQYERS  • 

S (EYg)^ 

(172) 

Sum  of  the  squares  of  the  yield 

errors 

Data  Set  15  {At  Zone  Level) 

> 

Program 

Engineer 

Symbol 

Symbol 

Equation 

Definition 

NT 

1. 

SQAERZ 

S (EA^)'^ 

(173) 

Sum  of  the  squares  of  the  area 

errors 

NT 

2, 

SQPERZ 

2 (EP„)'' 

(174) 

Sum  of  the  squares  of  the 

£-X 

production  errors 

3. 

SQYERZ. 

NT  /-pY  \ ^ 

(175) 

Sum  of  the  squares  of  the  yield 

errors 

Data  Set 

16  (At  Region 

Level) 

Program 

Engineer 

- Symb  ol 

Symbol 

'NT 

Equation 

Definition 

1. 

SQAERR 

2 (EA^)'" 

(176) 

Sum  of  the  squares  of  the  area 

errors 

NT 

2, 

SQPERR 

2 - (EPj^)^ 

NT 

(177) 

Sum  of  the  squares  of  the 
production  errors 

3. 

SQYERR 

2 (EYj^)^ 

(178) 

Sum  of  the  squares  of  the  yield 

errors 
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Data  Set  17  (At  Country  Lievel) 


Program 

Symbol 

Engineer 

Symbol 

NT  ' „ 

Equation 

Definition 

1. 

SQAERC 

H (EA^)'^ 
NT 

- (179) 

Sum  of  squares  of  the  area 
errors 

2. 

SQPERC 

S (EP^)^ 
NT 

(180) 

Sum  of  the  squares 
production  errors 

of  the 

3. 

SQYERC 

L (EY^)^ 

(181) 

Sum  of  the  squares 
errors 

of  the  yield 

Data  Set  18  (At  CountrY  Level) 


This  data  set  is  computed  only  after  the  last  Monte  Carlo  trial. 


Program 

Engineer 

Symbol 

Symbol 

Equation 

Definition 

CLWA 

CLWA 

(182) 

Confidence  level  about  the  true 
WA 

CLPRD 

CL  PRD 

(183) 

Confidence  level  about  the  true 
production 
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(1) 


(2) 


(3a) 

(3b) 

(4a) 

(4b) 

(5a) 

(5b) 

(6a) 


APPENDIX  C 

IMPLEMENTATION  EQUATIONS 


(AREA)j^ 

^ NA  (A  REA  PS) 
where 

(AREA)j^  = Substrata  land  area  in  hectares, 

NA  = No.  of  allocated  segments  in  a substrata, 

AREAPS  = Area  per  segment  in  hectares. 

Summation  of  Estimated  PW 

A 

(2a)  S PV7j. 


(2b)  S PW3. 

1 

MIK  , _ 

EPW2K  = L PW,. 

1 


li 


M2K  ^ 

EPW2K=  S PW.,.'=^ 

Zi 

mik 

SMPKPI  = £ (PWj^)  (PW^.) 


= PW, 


SMPKPI  = 


PW. 


MIK 

SUMPK2  = 2 = Mjj^  ^K^ 


M2K 

SUMPK2  = S “ ^2K 


MIK  ^ 

SUMPK  = L PW„  =M,„PW„ 


A 

PW 

A 

PW 


IK 

2K 


C-1 
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(6b) 

(7) 

(8) 

(9) 

(10) 

(11) 

(12) 

(13) 

(14) 

(15) 

(16) 
(17) 


M2K  ^ 

SUMPK  = S PW^  = PW^^ 


True  wheat  area 

" (^REAPS)  * 


whe3-e  WA^  = WA^j^, 


PWk  = PW^K.  or  PW3^ 


Historical  wheat  area 


WA^  = Nr  * Rr  * (AREAPS)  =5^ 


'where  ■ WAjj  = WA  WA^j,,  or  WA 


PWr  = PWjj,.  PW^jj.  or  PW3J, 


Estimated  wheat  area  ^ 

A PW 

WAik  = * Rk  * (AREAPS)  * 


MYVK  = (WAj^j^  * ^^4^  longer  used) 

.r  2 


VMU'LTK  =(l  - ---■  ^ R 


■k"  fe:  (AREAPS)" 


^2 

ANALVK  = (PW^j^  * VMULTK 

PW’j^  = f (RN,  CV^,  IWj^)  (no  longer  used) 

is  computed  by  the  Beta  Distribution  subroutine  given 
mean  PWj^  and  0“  = PWj^  * CV  ^ 

WAV  = CV4=f=-V^,^ 

j\  JS. 

MYVK  = (WA^j^  * EV^)^  (no  longer  used) 

Rk^  (N  ^ - Nk)  ? 

VMULTK — ^ (AREAPS)  (incomplete  - see  Eqn.  (36)) 


,2  ~ 

ANALVK  = (PW^j^  >!=  CV3)  VMULTK  « WA2j^ 
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(18) 

(19) 


MYVK  = * CV^)  (no  longer  used) 


SI 

TWASl  = S WA 
K 


IK 


SI  ^ 

(20)  HWASl  = S WA 

K 

SI  A 

(21)  EWASl  = H WA 

K 


IK 


IK 


SI 

(22)  MIJS  = S M 


K 


IK 


SI 

(23)  MYVSl  = L MYVK  (no  longer  used) 

K 

SI 

(24)  VMULjSI  = S VMULTK  (no  longer  used) 

K 

SI 

(25)  ANVSl  = L ANALVK 

K 

SI  ^ SI 

(26)  EPWSl  = S PW,.=  L EPWK  (no  longer  used) 

i,  K K 


SI 

SI 

(27) 

EPW2S1 

= S 
i,K 

PW,.^ 

u 

= s 

K 

EPW2K 

(no  longer  used) 

SI 

A 

SI 

(28) 

PKPISl 

II 

(PW^)  (PW..)  = s SMPKPI  (no  longer  used) 

SI 

SI 

(29) 

PK2S1  = 

S (PW^)‘‘  = 

L 

SUMPK2 

(no  longer  used) 

i,K 

K 

• 

SI  ^ SI 

(30)  PKSl  = S PW  = L SUMPK  (no  longer  used) 
■ i,  K ^ K 
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S2 

(31)  TWAS2  = L WA 
K 


2K 


S2  ^ 

(32)  HWAS2  = S 
K 

'vTa 


(33)  EWAS2  = 


2S 


2K 


S2  PW. 


WA 


2S 


2j  i,K  PW 


K 


M_'. 

2j 


* P2IDPK 


S2 

(34)  M2JS  = S M 
K 


2K 


S2 

(35)  MYVS2  = L MYVK  (no  longer  ased) 
K 


WA 


(36)  VMULTK= 


2S 


2j 


* VMULTK  (see  Eqn.  (16)) 


51 

(37)  CTIS  = L CT 

K 

52 

(38)  CT2S  = S CT, 

K 


(39)  T=J 


0 (at  option  of  user  or  if  M2JS  < 2) 
or 


^WA'k 


kK=l  K'=K+1  ^ ^ V 7T 


where 


7T„  = M_ . 
K 2j 


^K'  “ ^2j 


^■^2K 


WA 


2S  -• 


WA 


2K' 


L-^.^23  -i 


K- 

K ■ ^ 


(if  M2JS>i) 
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(M  - 1) 


M,.  - 1 

3± 


K"  ”T7^"2  ^K'  ’^K 


2j 


"^2J 


(M  - 1)  S2'  2(M  - 1)  ■ 

, 0=  1 . 


2j 


2j- 


M,.- 

2j 


o . . o S2  3 (M  - 1)  ^ ,S2-  ,>.2 

(TTj^  7T^,  + TT^,  ^ Jil  ^ \x-l  ^ 


2(M  - 1)  S2  , 

L ) (7T  ) S 

■ M,.  ^ ^ “ 

-&J  • • 


2j 


WA 


2« 


WA 


2S 


(40) 


(41) 


S2 

1 

ANVS2  = 

S 

K 

ANALVK 

- 

^2j 

J 

S2 

A 

S2 

EPWS2  = 

2 

PW„.  = 

2i 

2 

i.K 

K 

S2  ^ ^ S2 

(42)  EPW2S2  = S PW-.  = S EPW2K  (no  longer  used) 

i,  K K 

^ s S2 

(43)  PKPIS2  = S (PW„)  (FW-.)  = 2 SMPKPI  (no  longer  used) 

i,  K ^ K ■ 

S2  S2 

(44)  PK2S2  = L (I^t^)^  = 2 SUMPK2  (no  longer  used) 

i.K  ^ K 


S2  ^ S2 

(45)  PKS2  = L PW^  = 2 SUMPK  (no  longer  used) 
i,  K ■ K 
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S2 

(46)  P2IDPK  = L 
i,K 


^^2i  _ 

S2 

Tj 

1 

(^K>i  " 

K 

PW 

S2 

y. 

A 

PW 

^2K 

K 

PW 
^ K 

K 

S 

1 


A 

PW 


2i 


S3 

(47)  = S 

S3  ^ 

(48)  = S 


Z 

(49)  M1K2KZ  = S (MIJS  + M2JS) 


(50) 

(51) 

(52) 

(53) 

(54) 

(55) 

(56) 

(57) 

(58) 


class 

M1K2CL=  L (MIK  + M2K) 
class 

EPWCL=  S EPWK 
class 

EPW2CL=S  EPW2K 
s s 

PKPICL=S  ■ SMPKPI 
class 

PK2CL=’2  SUMPK2 
class 

PKCL=  S SUMPK 
Z 


TWAZ  = 2 (WAjg  + WA^g  + WA^g) 


i£  M1K2KZ  < 2, , 


HWAZ2  = < 


2 (WAjg  + WA^g)  if  M1K2KZ  ^ 2 


MYVZ  = < 


if  M1K2KZ  < 2, 


2 (MYVSi  + MYVS2)  -if  M1K2KZ  ^ 2 


(no  longer  used) 
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(59)  ESTVZ  = 


(60)  EWAZ2=^ 


0 

Z 

0 


5‘ 

S (WAjg  +-WA2g) 


(61)  HWAZ1=  ^ 


0 


(62)  EWAZ1= 


(63)  EZ  = J 


0 


EWAZl 


if  M1K2KZ  < 2, 


if  M1K2KZ  s 2 


if  M1K2KZ  < 2, 


if  M1K2KZ  s 2 


if  M1K2KZ  = 0, 


(no  longer  used) 


S (WA^g  + WA^g)  if  M1K2KZ  ^ 1 


if  M1K2KZ  = 0, 


Z A A 

S (WA^g  + WA^g)  if  M1K2KZ  ^ 1 


if  M1K2KZ  = 0, 
if  M1K2KZ  S:  1 


(64)  B = 


HWAZl 

M1K2CL,  * PKPICL  ~ EPWCL  » PKCL 
M1K2CL  >5=  PK2CL  - PKCL^ 


(65)  A = 


EPWCL  - B * PKCL 
M1K2CL 


(66) 


EPW2CL  - 


EPWCL 

M1K2CL 


M1K2CL  - 1 


if  2^M1K2CL<H 


„ 2 EPW2CL  - A =!=  EPWCL  - B ^ PKPICL 

S = =5 M1K2KZ  s H 

o M1K2CL  - 2 

S ^ is  not  defined  for  M1K2CL  2, 
o 
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(67) 

= MIN  ( 

'{AREA  PS)  ^ ^2^ 

<•  4 ’ y 

is  not  defined  for  MlK2CLi<  2. 

(68) 

Z 

HWAZ3  = L 

(HWASl  4 HWAS2  + HWAS3) 

0 

(69) 

ANALVZ=  •< 

Z 

S (ANVSl  4 ANVS2  4 T) 

(70) 

R 

TWAR  = - S TWAZ 

(71) 

R 

HWAR2  = L 

HWAZ2 

(72) 

R 

MYVR  = S 

MYVZ  (no  longer  used) 

(73) 

R 

ESTVR  = S 

ESTVZ 

(74) 

R 

EWAR2  = S 

EWAZ2  (no  longer  used) 

(75) 

R 

HWARl  = S 

HWAZl 

(76) 

R 

EWARl  = S 

EWAZl 

(77) 

„ EWARl 

R HWARl 

(78) 

R 

M1K2KR  = L M1K2KZ 

(79) 

R 

ANAEVR  = L ANALVZ 

(8b) 

C 

TWAC  = S 

TWAR 

(81) 

c 

HWAC2  = S 

HWAR2 

(82) 

' C 

MYVC  = S 

MYVR  (no  longer  used) 

over  all  strata  without 
acquired  fegments 

if  M1K2KZ  < 2 
if  M1K2KZ  s:  2 


C-8 


(83) 

(84) 

(85) 

(86) 

(87) 

(88) 
(89) 


C 

ESTVC  = L ESTVR 
C 

EWAC2  = S EWAR2  {no  longer  used) 
C 

HWACl  = L HWARl 


C 

EWACl  = L EWARl 


^ ^ EWACl 

■^C  ■ HWACl 

Q 

M1K2KC  = L M1K2KR 
C 

ANALVC  = L ANALVR 
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(90)  Eg  = 


EWASl  + EWAS2 
HWASl  + HWAS2 

if 

MIJS  + M2JS  ^ 1 

if 

Ml  JS  + M2JS  = 0 and  M1K2KZ  ^ 1 

if 

M1K2KZ  = 0 and  M1K2KR  ^ 1 

if 

M1K2KR  = 0 and  M1K2KC  ^ 1 

(91)  V1V2S  = S VMULTK  * SSQ(NCLASS) 


where  NCLASS  is  the  class  number  for  substrata  K. 

The  summation  is  over  all  substrata  with  acquired  segments. 
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(92a)  TAD2S  = (x  + grAllTWASZ-)" 

(92b)  AVARS  = .TAU2S  ^ (V1V2S  + T)  for  strata  with  acquired,  segments 

(92c)  ANA  VS  = TAU2S  (ANVSl  + ANVS2  + T)  for  strata  with  acquired 

segments 


(93a) 

(93b) 

(93c) 

(93d) 


HWAZ12 


r 

HWAZ2 
< HWAR2 
HWAC2 


if  M1K2KZ  ^ 2 

if  M1K2KZ  < 2 and  MIM2ZR  4 0 
if  M1M2ZR  = 0 


WRATIO  = 


( HWAS  Y 
V HWAZ12  J 


AVARS  = WRATIO  - ESTVZ  if  M1K2KZ  < 2 or 

if  MIJS  + M2JS  = 0 

ANAVS  = WRATIO  * ANALVZ  if  M1K2KZ  < 2 or 

if  MIJS  + M2 JS  = 0 


(94) 

(95) 

(96) 

(97) 

(98) 

(99) 
(100) 
(101) 
(102) 

(103) 

(104) 


(105) 

(106) 

(107) 

(108) 

(109) 

(110) 
(111) 
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HWAS  = HWASl  + HWAS2  H-  HWAS3 
TWAS  = TWASl  + TWAS2  + TWAS3 
EWAS  = EWASl  + EWAS2  + Eg  * HWAS3 

A ERRS  = EWAS  - TWAS 

AVARS  = ESTVS  * TAU2S  + 2 * (EWAS12)^  SIGM2S  (replaced  by  Eqns. 

92b,  93c) 

TPRODS  = YS  =*  TWAS 
EPRODS  = ESTYS  - EWAS 
PRERRS  = EPRODS  - TPRODS 

PRVARS  = AVARS  (ESTYS^  - EVYRS)  + EWAS^  EVYRS 

yerrs  = . 100 

ANA  vs  = F TAU2S  + 2 ^ EWAS12^  =5=  SIGM2S  (replaced  by  Eqns.  92c,  93d) 
where 

r 


ANVSl  + ANVS2  + T 

if 

MIJS  H-  M2JS  ^ 

1 and  M1K2KZ  ^ 2 

ANALVZ 

if 

MIJS  + M2JS  = 

0 and  M1K2KZ  s 2 

ANALVR 

if 

M1K2KZ  < 2 and  M1M2ZR  = 1 

ANALVC 

if 

M1M2ZR  = 0 

ANPRVS  = ANAVS  (ESTYS^  - EVYRS)  + EWAS^  « EVYRS 
Z 

HWAZ  = S HWAS 
Z 

TWAZ  = S TWAS 
Z 

EWAZ  = L EWAS 


AERRZ  = EWAZ  - TWAZ 


AVARZ.= 


HWAZ3 
HWAZ  12 


+ 


HWAS3 

HWASl  + HWAS2 


Z 

TPRODZ  = S TPRODS 


C-11 


(112) 

(113) 

(114) 

(115) 

(116) 

(117) 

(118) 

(119) 

(120) 
(121) 
(122) 

(123) 

(124) 
(126) 
(126) 

(127) 

(128) 
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EPRODZ  = S EPRODS 


PRERRZ  = EPRODZ  - TPRODZ 


PRVARZ  = S PRVARS 


TYZ  = 


TPRODZ 

TWAZ 


= EPRODZ 
EWAZ 


YERRZ  = TYZ^^'^  ) " 

Z 

MIZ  = S MIJS 


Z 

M2Z  = S M2JS 
Z 

CTIZ  = S CTIS 
Z 

CT2Z  = S CT2S 
Z 

CT3Z  = S CT3S 


ANAVZ  = S (ANVSl  + ANVS2  + T)  * (^1  + + 


Z 


ANPRVZ 

z: 

L ANPRVS 

R 

HWAR  = 

L 

HWAZ 

R 

TWAR  = 

L 

TWAZ 

R 

EWAR  = 

S 

EWAZ 

AERRK  = 

EWAR  - TWAR 

m’~AS3 

HWASl  + HWAS2 
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R 


(129) 

AVARR  = S AVARZ 

(130) 

R 

TPRODR  = L TPRODZ 

(131) 

R 

EPRODR=  S EPRODZ  ’ '' 

(132) 

FRERRR  = EPRODR  TPRODR 

(133) 

R 

PRVARR  = S PRVARZ 

(134) 

TPRODR 

TWAR 

(135) 

EFRODR 
- EWAR 

(136) 

YERRR  = 

(1'37) 

R 

MIR  = L Ml'z 

(138) 

R 

M2R  = L M2Z 

(139) 

R 

CT1R=  L CTIZ 

(140) 

R 

CT2R  =■  L CT2Z 

(141) 

R 

CT3R  = S CT3Z 

(142) 

R 

ANAVR  = S ANAVZ 

(143) 

■ R 

ANPRVR  = S ANPRVR 

(144) 

C 

HWAC  = S HWAR 

(145) 

C 

TWAG  = S TWAR 

C-13 


28234-6029-RU-00 
Page  139 


C 


(146)  • 

EWAC  = S EWAR 

(147) 

AERRC  = EWAC  - TWAC 

(148) 

C 

AVARC  = S AVARR 

(•149) 

C 

TPRODC  = E TPRODR 

(150) 

C 

EPRODC  = L EPRODR 

(151) 

PRERRC  = EPRODC  - TPRODC 

(152). 

C 

PRVARC  = L PRVARR 

(153) 

„„„  _ TPRODC 
^ TWAC 

(154) 

EPRODC 
~ EWAC 

(155) 

YERRC  = * 100 

(156) 

c 

MIC  = S MIR 

(157) 

C 

M2C  = S M2R 

(158) 

C 

CTIC  = S CTIR 

(159) 

C 

CT2C  = L CT2R 

(160) 

C 

CT3C  = L CT3R 

(161) 

C 

ANAVC  =■  S ANAVR 

(162)' 

C' 

ANPRVR  = S ANPRVR 

C-14 


(163) 


(164) 


(165) 


(166) 
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CLEWA  = [-2  - P (X)  - 1]  100 

where 

^ 0.  1 * EWAC 
X=  - 

y = MAX  [(AVARC)^^^  , 10"^°] 

P'(X)  is  given  by  Equation  (164)o 

-4 

P (X)  = 1 - (1  + 0.  196854X  + 0.  115194X^  + 0.  000344X^  + 0.  019527X^) 

if  X is  positive, 

P(X)  = (1  + 0.  196854jXj40.  H5194iX|^  + C.  000344jXj^  + 0,  019527jX|^) 

if  X^  is  negative. 

CLEPRD  = [2  * P (X)  - 1]  ^ 100 
where 

_ 0.  1 * EPRODC 

X - - _ 

Y = MAX  [(PRVARC)^^^  , 10 
P (X)  is  given  by  Equation  (164), 


CEATEC  = [P(X^)  - P(X2)]  * 100 


where 

^1  = 

EWAC  - 0,  9 * TWAC 

Y 

^2  = 

EWAC  - 1.  1 =^=  TWAC 

Y 

■ Y = 

MAX  [(AVARC)^^^  , 10“^°] 

P(X) 

is  given  by  Equation  (164). 

C-15 


C-16 
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(173) 

. NT 
SQAERZ  = L 

(AERRZ)^ 

(174) 

NT 

SQPERZ  = S 

(PRERRZ) 

(175) 

NT 

SQYERZ  = L 

(YERRZ)^ 

(176) 

NT 

SQAERR  = S 

(AERRR)^ 

(177) 

NT 

SQPERR  = S 

(PRERRR) 

(178) 

NT 

SQYERR  = S 

(YERRR)^ 

(179) 

NT 

SQAERC  = r 

(AERRC)^ 

(180) 

NT 

SQPERC  = S 

(PRERRC) 

(181) 

NT 

SQYERC  = S 

(YERRC)^ 

(182) 

CLWA  = [P  (X^ 

) - P (X^)]  ^ 

where 


NT  NT 

S EWAC  - 0.  9 * S TWAC 


-o*  ^ — ■ 

NT  * Y 

•-  ^2  = 

NT 

S EWAC  - 1.  1 * 

NT 

S TWAC 

NT  - Y 

Y = 

1 /? 

MAX  [(VEA^) 

, io“3°] 

VEA^  = 

NT  - 

SQAERC  - ( L AERRO^/NT 

NT  ^ 1 

P (X)  is  given  by  Equation  (164). 


C-17 
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(183)  CLPRD  = [P(Xj)  - P(X2)]  * 100 
where 


. NT 


EPRODC  - 0,9 
NT  * Y 


NT 

S T PRO DC 


• • NT  NT 

^ ^ S EPRODC  - 1.  1 ^ S TPRODC 
2 NT  - y 

Y = MAX  [(VEP^)^^^  , 10~^°] 

NT  . 

. _ SQPERC  - ( S PERRC)  /NT 

C “ NT  - 1 

P (X)  is  given  by  Equation  (164). 


(184) 


/ NT 

1 

J S AVARS 

CV  AREA  EST 

i NT 

(PCT  TRUE) 

NT 

S 

S TWAS 

NT 


X 100 


(185) 


AREA 
CV  ERROR 
(PCT  TRUE) 

S 


X 100 


(186) 


YIELD 
ST  DEV  ■ 
PCT  ERROR 


SQYERS 


NT 

IS 


YERRS) 


Vnt 


NT  - 1 


(187) 


CV  PRD  EST 
(PCT  TRUE) 


S 


/ NT 

s 

PRVARS 

V NT 

NT 

S 

TPRODS 

NT 

X 100 


C-18 


(188) 


(189) 


(190) 


(191) 


(192) 


(193) 
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PKD 

CV  ERROR 
(PCX  TRUE) 


S 


VSQPERS  - ( S PRERRS)VnT 

NT  - 1 

NT 

S TPRODS 
NT 


X 100 


CV  AREA  EST 
(PCX  TRUE) 

Z 


NT' 

S AVARZ 


NT 


NT 

S TWAZ 
NT 


X 100 


AREA 
CV  ERROR 
(PCX  TRUE) 


NT 


SQAERZ  - ( S aerrz)Vnt 


NT  - 1 


NT 

S TWAZ 
NT 


X 100 


~ YIELD  “ 
ST  DEV 
PCX  ERROR 

Z 


SQYERZ  - 


( s yerrziVnt 


NT  - 1 


CV  PRD  EST 
(PCX  TRUE)_ 

Z 


/ NT 

PRVARZ 

V NT 

NT 

L 

TPRODZ 

NT 

X 100 


PRD 

CV  ERROR 
(PCX  TRUE) 


VSQPERZ  - ( S PRERRZ)VnT 

NT  - 1 

NT. 

S TPRODZ 
-NT 


X 100 


C-19 
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(200) 


AREA 
CV  ERROR 
(PCT  TRUE) 


C 


SQAERC 


NT 


aerrqVnt 


NT  - 1 


NT 

S TWAC 
NT 


X 100 


(201) 


r YIELD 
ST  DEV 
PCT  ERROR 


Y 2/ 

W SQYERC  - ( S YERRC)  /NT 
f NT  . 1 


(202) 


CV  PRD  EST 
(PCT  TRU-E)  " 
C 


' NT 

S 

PRVARC 

NT 

NT 

S 

TPRODC 

NT 

X 100 


(203) 


~ PRD 
CV  ERROR 
(PCT  TRUE) 


C 


NT 


(204)  CV 

■ ANAL  WA 
(PCT  TRUE) 


NT 

L ANAVC 


NT 


NT 

S TWAC 
NT 


X 100 


(205)'  CV 

ANAL  PRD  = 
(PCT  TRUE) 


NT 

S ANPRVC 


NT 


NT 

S TPRODC 
NT 


X 100 


C-21 


28234-6029-RU-00 
Page  147 


PART  I 

PROBLEM  DESCRIPTION 
FOR  THE  YES  SUBPROGRAM 


YES  PROBLEM  DESCRIPTION 
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1.0  SCOPE 

1.1  Program  Capabilities.  Ttie  YES  model  is  designed  to  simulate  the  yield 
■estimation  process  of  the  LACIE  System.  The  model  generates  the  yield  estimates 
at  the  strata  level  of  from  one  to  six  given  estimation  points  in  a simulation 
season.  The  estimates  are  computed  from  the  true  yield  given  in  the  input  data, 
taking  into  account  the  effects  of  various  estimation  errors.  The  output  from 
YES  is  used  by  CAS  in  calculating  the  production  estimates.  An  option  allows 
the  estimated  yields  to  be  the  same  as  the  true  yields,  bypassing  the  error 
simulation.  A printed  report  of  the  estimated  yields  is  optional. 

1.2  Program  Development  and  Organization.  This  subprogram  will  be  developed 
in  FORTRAN  as  an  overlay  of  the  LEM  program.  See  the  LEM  problem  description, 
Section  1.2. 

1.3  Operational  Assumptions.  See  the  LEM  problem  description.  Section  1.3. 
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2.0  INPUT 

There  is  one -input  file.  The  control  card  input  for  YES  is  included  on 
the  LEM  control  card. 

Cards.  See  the  LEM  control  card  Section  2.1.  Inputs  relevant  to  YES  in- 
cludes 


RSEED5 

the  initial  random  number  seed  for  use  in  simulating  the 
yield  error. 

0ES 

= 0,  1 

estim.  yield  includes  error  simulation 

= 3 

estim.  yield  = true  yield 

IPRYES 

= 0 

printed  report  for  1st  and  last  iterations 

= 1 

printed  report  for  all  iterations 

= 2 

printed  report  for  last  iteration  only 

= 3 

no  printed  report 

2-2  Files.  The  only  input  file  to  YES  is  the  YES  ERROR  MODEL  FILE  (YESERR), 
generated  by  the  SEEprogram.  See  Section  2.4  of  the  Users  Manual  for  the  format 


and  contents. 
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3.0  PROCESSING 

See  Figure  1-for  a flow  diagram  of  YES.  The  heart  of  YES  is  the  calcu- 
lation of  the  equation: 

YSCI  = YSTR  + BIAS-+  RN*SD 

for  each  estimation  point  (up  to  6)  for  each  strata,  where: 

YSCI  = estimated  yield 
YSTR  = true  yield 
BIAS  = bias  factor 
. SD  = standard  deviation 
RN  = random  number  from  a normal  distribution 


input  quantities  from  YES 
input  file 
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4.0  OUTPUT 

4.1  Print  Data.  The  printed  report  is  optional,  determined  .by  the  LEM  control 
card  input,  IPRYES.  See  Figure  2 for.  an  example  report. 

4.2  Files.  The  only  output  file  from  YES  is  the  YES. file,  used  by  CAS.  See 


Section  2. -x  of  the  Users  Manual  for  the  format  and  contents. 


COUNTRY  

PREDICTION  DATE 
' - MO/DY/YR 


COUNTRY  

PREDICTION  DATE 


CASE  page 


YES  YIELD  ESTIMATE  DATA  REPORT  - ITERATION  NO.  

REGION  ZONE  ■ STRATUM  ^ 

. TRUE.  YIELD  ESTIM.  YIELD  PERCENT  STANDARD.  DEV-. 

QUIN/HECTAR  . QUIN./HECTAR  ERROR  QUIN./HECTAR 

: ^ 3 strata 

— PER  PAGE 


REGION  ZONE  STRATUM  

TRUE  YIELD  ESTIM.  YIELD  PERCENT  STANDARD  DEV 


Figure  2.  YES  Report  Format 
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5.  0 ERROR  PROCESSING 

There  are  two  possible  errors  besides  system  errors  in  YES,  which 
generate  the  following  messages: 

YES  INPUT  FILE  (YESERR)  - BEGINNING  I.EGION  AND  ZONE 

NOT  FOUND 

YES  INPUT  FILE  (YESERR)  - ENDING  REGION  AND  ZONE 

NOT  FOUND 

K the  beginning  region  and  zone  are  not  found,  this  is  a fatal  error,  and 
causes  return  of  control  immediately  to  LEM.  If  the  ending  region  and 
zone  are  not  found,  this  generates  a warning,  but  LEM  will  continue, 
having  processed  all  records  from  the  beginning  region  and  zone  to  the 
end  of  file.  The  beginning  and  ending  regions  and  zones  are  specified  on 
the  LEM  control  cards. 
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PART  n 


LEM  COMMON  BLOCKS 
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COMMON  BLOCKS  FOR  THE  LEM  PROGRAM 


COMMON 

BLOCK 

ARGLST 

CAMS  CM 

CAS  CM 

CAS  CUM 

CASFLG 

CNTRL 

CONST 

DSETl 

DSET4 

DSET7 

DSET8 

DSET9 

DSETIO 

DSETll 

DSET12 

DSET13 

FILES 

IXCASF 

IXCDSF 

IXDISF 

LEMCM 

PAGECM 

SEGDTA 

SSHDTA 

STATS 

STGDTA 

SUMDTA 

YESDTA 

FILES! 

CLSTAB 

IXSUBH 


DESCRIPTION 

Argument  list  for  error  processing 
CAMS  control  card  input  data 
CAS  control  card  input  data  and  constants 
Data  block  for  CAS  cumulative  file 
Flags  and  counters  for  CAS  simulator 
Control  parameters  for  LEM  program 
Constant  quantities  for  LEM  program 
CAS  data  sets  1,  2,  and  3 

CAS  data  sets  4,  5j  and  6 (at  strata  level) 

CAS  data  set  7 (at  zone  level) 

CAS  data  set  8 (at  region  level) 

CAS  data  set  9 (at  country  level) 

CAS  data  set  10  (strata  data  — second  pass) 

CAS  data  set  11  (zone  data  --  second  pass) 

CAS  data  set  12  (region  data  --  second  pass) 

CAS  data  set  13  (country  data  — second  pass) 

File  definitions  and  record  lengths 
Index  record  for  CAS  cumulative  file  (CASF) 

Index  record  for  CAS  intermediate  data  set  fi  .e  (CASDSF) 

Index  record  for  CAS  distribution  file 

LEM  control  card  input  data 

Page  eject  control  parameters  for  LEM 

Segment  data  from  CAMS  output  file  (CAMSF) 

Substrata  Historical  data  from  SUBHST  file 
Statistical  information  for  LEM 
Data  for  Segment  Truth  Generator 
Summary  data  for  reports 
Yield  data  from  YESOUT  file 
Supplemental  file  definitions 

Contains  data  necessary  to  compute  class  numbers 
Index  record  for  CAS  intermediate  SUBHST  file 
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COMMON  STORAGE  ALLOCATION 

Name'  ARGLS  T Size  lA-  Page  1 of l 

* 

Function  Argument  List  for  Error  Processing 


For-' 

mat 


I 


I 


I 


Description 

Number  of  nonfatal  input  errors 

Number  of  fatal  input  errors 

Number  of  errors  during  processing 
Number  o^  arguments  in  list 
Argument  list  (real) 

Argument  list  (integer) 


Sym- 

bol 


NOTE:  ARC  and  lARG  are  equivalenced. 


Name CAIvISCM 


COMMON  STORAGE  ALLOCATION 
Size  13  8 


CAMS  control  input  (see  also  Input, 
Function  CAMS  Problem  Description,  Section  2.  1) 
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Page  1 of  1 


Description 


IMODEL 


IMULTI 


ISIGEX 


ISKIP 


IGB.OUP 


MS 


G 

(3,2,  2) 

R 

H 

(3,2,  2) 

1 R 

= 1 mixed  crops  model 
=2  simple  model 


=0  include  multi-temporal  error 

9^0  bypass  multi-temporal  error ; 


=0  additive  model  I of  signature 

?^0  multiplicative  model  j extension 


=0  skip  '1  what  to  do  if  no 

^^0  classify  as  training  f correlation 


Max,  no.  days  between  training /ordinary 
segment  correlation 


=0  print  error  breakdown  report 

no  print  of  error  breakdown  report 


1-4  which  window  to  use 
0 defaults  to  4 


Multi-Temporal  Matrix 


Dimension  3 = which  M value  to  use  for 
each  of  15  states 


(3,  2,  3)  R Values  for  Ml,  M2,  M3 


Crop  Calendar  Coefficients 


(3,  2,  2)  R G1  and  G2  values  for  quadratic  function 


(3,  2,  2)  R HI  and  H2  values  for  quadratic  function 


Dimension  1 for  IGROUP,  MS,  G,  H 
TYPE  (wheat,  mixed,  other) 


Dimension  2 for  IGRQUP,  MS,  G,  H 
SEASON  (winter,  spring) 


Note:  If  model  2,  only  wheat  dimension  of 


IGROUP,  MS,  G,  H,  non-empty 
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COMMON  STOKIGE  ALLOCATION 


Name  CAS  CM 


Sige  100 


Page  - 1 of ^ 


Fimctlon  CAS  Control  card  Input  Data  and  Cons  tants 


Description 


F Area  conversion  factor  for  printout 


2.471044E-4  (hectares  to  10,000  acres) 


or  0.001  (hectares  to  1000  hectares) 


F Yield  conversion  factor  for  printout 


1.4869664  (quintals/hectare  to  bushels/acre' 


F Production  conversion  'factor  for  printout 


3.6743544E-5  (quintals  to  100,000- bushels) 


or  1 E-4' (quintals  to  1000  metric  tons) 


4a6  I Area  units  labels  for  printed  repo^^ 


APRUTS(1,1)  - "TEN  THOUSAND  ACRES" 


APRUTS(1,2)  - "THOUSAND  HECTARES" 


5A6  Production  units  labels'  for  printed  reports 


PPRUTS(1,1)  - "HUNDRED  THOUSAND  BUSHELS" 


PPRUTS(1,2)  - "THOUSAND  METRIC  TONS" 


3A6  Yield  units  labels  for  printed  reports 


YPRUTS(1,1)  - "BUSHELS /ACRE"  ■ 


YPRUTS(1,2)  - "QUINTALS /HECTARE" 


Units 


COMMON  STORAGS  ALLOCATION 
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Name  CAS  CM 


Size 


Funct i on  CAS  Input  Data  and  Constants 


Dimen- 


Description 


Sym- 

bol 


AREAPS 


Area  per  segment  (builtin  value  = 10289.712] 


Maximum  value  of  S 


(Built  in  value  = 10289 .7 12^/4)> 


e 

Number  of  historical  years  for  group  III 


ratio  calculations 


Minimum  number  of  segments  required  for 


2 

applying  S regression  eguatxon 


T - option  flag:  


=0  to  set  T = 0, 

=1  to  calculate  T 


where  T is  the  second  term  of  the 
variance  equation  for  v^^ 

Units  option:  = 1 for  metric  units  - 


Area  in  thousands  hectares,  yield  in  quintals/ 
hectare;  production  in  thousand  metric  tons ; 


= 0 for  American  units  - 


area  in  ten  thousand  acres 
yield  in-  bushels  per  acres 


production  in  hundred  thousand  bushels 


CAS  distribution  file  flag 


=0  to  generate  CAS  distribution  file. 


= 1 otherwise 


COl-MON  STORAGE  ALLOCATION 
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Name  CAS  CM 


Size 


Page  3 of ^ 


Function  Input  Data  and  Constants 


APREP 


For- 

mat 


Description 


I I Prediction  dates; 


IPRD(l,n)  = year  - 1900 


IPRD(2,n)  = month  (1-12) 


IPRD(3,n)  = day 


Sym- 

bol 


Units 


Prediction  biowindow  flags: 

IWIND(n)  =1  to  process  biowindow  n, 


= 0 otherwise 


Biowindow  priorities: 


List  of  biowindows  in  decreasing  order 


of  priority 


I Area  and  Production  Print  flag: 


= 1 to  print  Area  and  Production 
= 0 otherwise 


The  prediction  dates  must  be  in  ascending  o:i|der 


The  first  zero  date  terminates  the  list 


I Number  of  prediction  dates 


I I List  of  prediction  dates 


(in  Zulu  date  format) 
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Name  CUM 


COMMON  STOMGE  ALLOCATION 


Size  536 


Fiinction  D^ta  Block  for  CAS  Cumulative  File  > 


Page  - 1 of 5. 


Description 


Units 

bol 


F Block  of  data  for  one  strata,  zone,  region 


or  country  for  a single  prediction  point 


(see  attached  sheets  for  details  of  format 


of  each  block) 


F Buffer  for  one  data  record  from  the  CAS 


Cumulative  File 


504  = 18  ■*  28j  18  prediction,  points 


28  words/pred.  pt. 


I Integer  name  equivalenced  to  CASCtM 


F Data  set  14  (strata  level) 


F Data  set  15  (zone  level) 


F Data  set  16  (region  level) 


F Data  set  17  (country  level' 


NOTE:  DSET14,  DSET15,  DSET16,  DS'ETl?  all 


are  equivalenced  to  CAS CUM (5) 


COMMON  STORA.GE  ALLOCATION 
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Name  CAS  CUM Size 

« 

Function  Data  Block  for  CAS  Cumulative  File 


Dimen-  For— 


Description 


Sym- 

bol 


S (area  error)  for  strata 


2 

E (area  error)  for  zone 


2 

Z (area  error)  for  region  ■> 


2 

S (area  error)  for  country 


SQAERS,  SQAERZ,  SQAERR,  and  SQAERC  are  all 
equivalenced  to  CASCUM(24). 


2 

E (production  error)  for  strata 


2 

E (production  error)  for  zone 


2 

E (production  error)  for  region 


2 

S (production  error)  for  country 


SQPERS,  SQPERZ,  SQPERR,  and  SQPERC 
are  all  equivalenced  to  CASCUM(25). 


2 

E (yield  error) 

for  strata 

2 

E (yield  error) 

for  zone 

2 

S (yield  error) 

for  region 

E (yield  error)^ 

for  country 

SQYERS,  SQYERZ,  SQYERR,  and  SQYERC  are  all 

equivalenced  to  CASCUM(26). 

R33PRODUCIBILITY  OF  THE 
ORtGINAL  PAGE  IS  POOR 
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COMMON  STOR'IGE  ALLOCATION 


Name  CAS  CUM Size 

Fiuichiort  Data  Block  for  CAS  Cumulative  File 


Name 


Dimen-  For- 


De script ion 


CASDSB 


Data  Block  for  the  CAS  Distribution  file 


(Data  Set  19) 


I Integer  name  for  CASDSB > 


HI7A2K 

1 60 

F 

HI^A2K(K)  specifies  the  historical 

group  II  substrata  in  the  current  stratum 


F i WAKNEY (K)  specifies  the  non-epoch  year  WA 


t*Vi 

for  the  K*”  group  II  substrata  in  the  curren' 


strata 


F PIK(K)  specifies  171^  for  the  group  II 


substrata  in  the  current  strata 


NOTE:  CASDSB,  ICASD,  HWA2K  are  all 


equivalenced  to  BUFFR; 


■WAKNEY  is  equivalenced  to  CASDSB (61); 


PIK  is  equivalenced  to  CASDSB (12I~ 


CAS CUM 


Page  4 of  5 
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FORMATS  OF  CAS  CUMULATIVE  FILE  RECORDS 


CAS  GUM 

Data 
Set  14 

Data 
Set  15 

Data  Data 

Set  16  Set  17 

1 

region 

region 

region  0 

2 

zone 

zone 

0 0 

3 

strata 

0 

0 0 

4 

0 

nstraz 

0 0 

5 

HI^A 

(Historical  WA) 

6 

TWA 

(True  WA) 

7 

El^A 

(Estimated  WA) 

8 

AERR 

(area  error) 

9 

AVAR 

(area  variance) 

10 

tpri6d 

(true  production) 

11 

EPR^D 

(estimated  production) 

12 

PRERR 

(production  error) 

13 

PRVAR 

(production  variance) 

14 

TY 

(true  yield) 

15 

EY 

(estimated  yield) 

16 

YERR 

(yield  error) 

17 

Ml 

(no.  of  group 

I segments) 

18 

m2 

(no.  of  group 

II  segments) 

19 

CTl 

(no.  of  group 

I substrata) 

20 

CT2 

(no.  of  group 

II  substrata) 

21 

CT3 

(no.  of  group 

III  substrata) 

22 

AMM 

(analytic  area  variance) 

23 

ANPRV 

(analytic  production  variance) 

CAS CUM 


CAS CUM 

Data 
Set  14 

Data 
Set  15 

Data 
Set  16 

24 

SQAERS 

SQAERZ 

SQAERR 

25 

SQPERS- 

SQPERZ 

SQPERR 

26 

SQYERS 

SQYERZ 

SQYERR 

27 

- 

- 

- 

28' 

- 

- 

- 

29 

- 

30 

- 

- 

- 

31 

- 

- 

- 

32 

_ 

Page  5 of  5 
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Data 
Set  17 

SQAERC 

SQPERC 

SQYERC 

CLEtJA 

CLEPRD 

CLATEC 

CLPTEC 

CLATWC 

CLPTWC 


NOTE:  The  quantities  in  CAS CUM (5 )- CAS CUM (23)  and  CASGUM(27)  - CASCl»I(32) 

are  the  accumulated  values  of  the  indicated  quantities  over  all 
iterations . 


COMMON  STORAGE  ALLOCATION 
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Name  CASFLG 


Size  40 


Page  1 of  3 


Function  Miscellaneous  Data,  Flags  and  Counters  for  CAS 


Dimen-  For- 


De script ion 


Sym- 


F Minimum  number  of  segments  required  for 


applying  S regression  equation. 


Prediction  point  Flag 

= 0 for  biowindovfls 

l 

~ 1 for  prediction  dates 


I Number  of  biowindows  (^4  ) 


Biowindow  index  (1-4 


I Windov?  index  (1-4)  


I Prediction  Date  index  (1-14) 


I Prediction  Point  index  (including  both- 


biowindows  and  prediction  dates) 


I I Zulu  date  associated  with  prediction  point 


I 1 Number  of  regions  in  countr 


Number  of  zones  in  country 


I I Number  of  strata  in  countr 


I Number  of  records  to  initially  skip  on 


YES0UT  file 


I I Number  of  records  to  initially  skip  on 


STJBHST  file 


Units 


COMMON  STORAGE  ALLOCATION 
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Name  CASFLG 


Size  40 


2 of  3 


Function  Miscellaneous  Data,  Flags  and  Counters  forCAS 


Dimen-  F or- 


De script ion 


IDSIO 


LDSll 


Number  of  records  to  initially  skip  on 


CAMS  file 


Data  record  count  on  YES^UT 


Data  record  count  on  SUBHST 


Data  record  count  on  CAMSF 


End  of  country  flag; 

7^  0 if  end  region,  end  zone 


End  of  region  flag; 

^ 0 if  end  of  region  reached 


End  of  zone  flag; 

7^  0 if  end  of  zone  reached 


Record  mzmber  of  strata 
record  on  CAS CUM  and  CASDSF 


Record  number  of  zone 
record  on  CAS CUM  and  CASDSF 


Record  number  of  region 
record  on  CASCUM  and  CASDSF 


I Length  of  Data  Sets  1,  2,  3 


I I Length  of  Data  Sets  4,  5,  6 


I I Length  of  Data  Set  7 


I I Length  of  Data  Set  8 


I Length  of  Data  Set  9 


I Length  of  Data  Set  10 


I Length  of  Data  Set  11 


COMMON  STORAGE  ALLOCATION 
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Name  CASFLG Size  40 

Ftmction  Miscellaneous  Data,  Fleas  and  Counters  for  CAS 


D'imen-  For- 
sion  ■ mat 


Description 


LDS12 


LDS13 


LRS.EG 


LRZ0NE 


LRSTR 


Sym- 

bol 


Units 


I 

Length  of  Data  Set  12 

I 

Length  of  Data  Set  13 

I 

Length  of  Data  Set  14 

I 

Length  of  Data  Set  15 

I 

Length  of  Data  Set  16 

I 

Length  of  Data  Set  17 

I 

No  longer  used 

I 

No  longer  used 

I 

No  longer  used 

I 

No  longer  used 

COMMON  STOR.\GE  ALLOCATION 
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Name  ■ CNTRL 


Size 


Page  1 of'  1 


Function  Control  Parameters 


Description 


I print  flag  for  modules 


STG,  CAMS,  YES,  and  CAS 


0 to  print  reports. 


= 1 otherwise 


I I Starting  iteration  number 


( = RSTART  + 1) 


D.pj  Random  number  seeds  for  error  sources 


SEED(l)  - Segment  Truth  Error 


SEED (2)  - Classification  Error 


SEED (3)  - Signature  Extension  Error 


SEED (4)  - Segment  crop  calendar  error 


SEED (5)  “ Yield  error 


SEED  (6)  - CAS  Group  II  error 


SEED  (7 ) - CAS  Group  III  error 
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Name  CtoST 

Function  CONSTANTS 


COMMON  STORAGE  ALLOCATION 
Size  5 


Page  I of 1_ 


Dimen-  F or- 


NTEMX 


IMXSEG 


MXCLS 


Description 


Units 

bol 


I Maximum  number  of  Monte  Carlo  trials  in  a 


single  run  (=100) 


I I Maximum  region  number  (=999) 


I Maximum  zone  number  (=999) 


I Maximum  number  of  segments  in  any  substrata 


(read  from  header  record  of  Substrata 


Historical  file) 


EM)FIL 

1 

F 

End  of  file  indicator  (-4HZZZZ) 

Maximom  number  of  substrata  classes  per 
zone  (10) 


COMMON  STORAGE  ALLOCATION 
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Name 


DSETl 


Size 14 


Function  Data  Sets  1,  2,  '3  (Substrata  Datal 


Dimen-  For- 


Description 


Sym- 

bol 


I Substrata  ID 


True  Wheat  Area  (WA' 


F Historical  Wheat  Area 


t 

F Estimated  Wheat  Area 


F No.  of  group  I segments  in  substratum. 


F Group  I flag: 


=1  if  substrata  is  in  group  I, 
= 0 otherwise 


F Analytic  area  variance 


F Estimated  proportion  of  wheat 


2 (PW  ) (PW. ) 


? (PW^)^  = M.-  m 

X ] K. 


? 


F Index  used  to  count  no.  of  group  II 


substrata  in  strata,  


Substrata  class  number  for  current 
.prediction  point 


COMMON  STORAGE  ALLOCATION 
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Name 


DSETl 


Size^A. 


Function  Data  Sets  2,  3 (Substrata  Data) 


Dimen-  For- 


De script ion 


Sym- 

bol 


No.  of  group  II  segments  in  substrata 


Note:  M2K  is  equivalenced  to  MlK 


Group  II  flag: 


=1  if  substrata  is  in  group  II, 
= 0 otherwise 


Group  III  flag;  


=1  if  substrata  is  in  group  III 
= 0 otherwise  


Note:  Since  CT2K  and  CT3K  are  equivalenced 


to  CTlK,  a value  1 is  also  stored 
for  the  location  CTlK. 


Data  Set  1 


F Data  Set  1 


F j Data  Set  3 


Note:  DSETl,  DSET2,  and  DSET3  are  all 


equivalenced  to  ISUBST. 


COMMON  STORAGE  ALLOCATION 
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Name  DSET4 


Size 


Function  Data  Sets  4,  5,  6 (at  Strata  level) 


Dimen-  For- 


De script ion 


'Sym- 

bol 


STRATA 


TWASl 


HWASl 


I Strata  ID 


F True  WA  (wheat  area) 


F.  Historical  WA  (Group  I) 


F Estimated  WA  (Group  I) 


F Group  I Analytic  variance 


F True  WA  for  group  II  segments 


F Historical  WA  (Group  II) 


F 1 Estimated  WA  (Group  II‘ 


F No.  of  acquired  group  II  segments  in  strata 


F No.  of  group  II  substrata  with  acquired 


F No.  of  acquired  group  I segments  in  strata 


F No.  of  group  I substrata  with  acquired  I CT. 
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COMON  S'lOMGE  ALLOCATION 


Name  PS  ETA Size  2 4 Page  ^ of ^ 

• Function  Sets  4,  5,  6 (at  Strata  level) 


m 

Dimen- 

sion 

For- 

mat 

Description 

Sym- 

bol 

Units 

ANVS2 

1 

F 

Group  II  Analytic  variance 

- 

ha^ 

T 

1 

F 

2nd  term  in  variance  eq. 

T 

ha^ 

- 

TWAS3 

1 

F 

r 

True  WA  for  group  III  segments 

^'^3S 

ha 

HWAS3 

1 

F 

Historical  WA  (group  III) 

ha' 

XCT3S 

1 

F 

No.  of  group  III  substrata 

XYS 

1 

F 

True  yield 

m 

Quintals 

ha 

XESTYS 

1 

F 

Estimated  yield 

Quintals 

ha 

EVYRS 

1 

F 

Variance  of  yield  error 

i^fl 

/Quintals^ 
k ha  / 

• 

■ 

1 

1 

1 

« • " 

! 

- 

J 

1 

- 

1 

1 

- 

) 

j 

- 

■ 

• . I 

1 

J 

- 

) 

1 

- 

( 

> 

COMMON  STORAGE  ALLOCATION 
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Name  PSET4 


Size  24 


Punct i or.  Data  Sets  4,  5,  6*  (at  strata.  level'! 


Name 


Dimen- 


DSET4 


VARS 


ANVARS 


For- 

mat 


Description 


Data  Set  4: 


Sym- 

bol 


Note;  Data  set  4 proper  consists  of  the  firs 
9 quantities  in  /DSET4 


Data  Set  5:  ' 


DSET5'  is  equivalenced  to  TWAS2 


F Data  Set  6; 


DSET6  is  equivalenced  to  TWAS3 


F I Estimated  area  variance 


F Estimated  analytic  area  variance 


COMMON  STORAGE  ALLOCATION 
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Name  PSET7 Size ^ 

Function  ^ level) 


Page  1 of ^ 


Name 


Dimen-  For- 


Description 


Sym- 

bol 


Units 


10 


EPW2CL  10 


PKPICL 


Historical  Wheat  area  (for  group  1,  2 segment 


Computed  only  if  M1K2HZS2 
Otherwise  = 0 


WA 

ha  . 

Nijmber  of  group  1,  2 segments  in  zone 


Group  1,  2 

Analytic  area  variance 


I Number  of  strata  in  zone  • 


F Historical  wheat  area  (group  1,2) 


Estimated  wheat  area  (group  1,  2) 


Total-historical  wheat  are  for  all  strata 
without  valid  segments 


Group  1,  2 variance  estimate 


Effective  group  1,  2 WA  for  compute  area 
variance  for  strata  without  s'egments 


Number  of  segments' in  each  substrata  class 

_=  S {M  I ^ + Mopj-) 


E.  <™l|  + W,K> 


COMMON  STORAGE  ALLXATIOH 
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Name  DSET7 Size  81  P&ge  2 _ of 2 

Function  Data  Set-  7 (at  zone  level) 


Name 

Dimen- 

sion 

For- 

mat 

Description 

! 

Sym- 

bol 

Units 

PK2CL 

10 

F 

PW,?  (for  each  substrata  class) 

1 jK  __  K ■ , - ■ - 

- 

PKCL 

■ 10 

F 

2 

. PW  " 

i,K 

- 

- 

SSQ 

10 

F ■ 

"2  ' ■ 

S factor  in  variance  equations 

- 

(for  each  substrata  class) 

DSET7 

81 

F 

Data  Set  7 

_ 

* 

Note;  DSET7  is  equivalenced  to  Z0NE 

• • 

- 

• 

• 

• 

- 
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COMMON  STORi^GE  ALLXATION 

Kame  PSET8  • Size  10 

yimftt.ion  Set  8 (at  Region  level) 


Dimen-  For- 

sion  mat 


Description 


REGI0N 


HWAR2 


I Region  ID 


F Group  1,  2 Historical  WA 


ESTVR 

1 

M1M2ZR 

1 

F Number  of  group  1,  2 segments  in  region 


p (Analytic  area  variance 


I , Number  of  zones  in  region 


F Historical  wheat  area  (group  1,  2) 


Estimated  wheat  area  (group  1,  2)  


Note:  HHARl  and  EWARl  are  always  computed  if 

there  is  at  least  one  group  I or  group  II  se 


ment  in  the  region, . HWAR2  and  EWAR2  are 
computed  only  if  some  zone  in  the  region 


contains  at  least  two  group  1,  2 segments. 
Group  1",  2 variance  estimate 


Group  1,  2 substrata  flag:' 


= 1 if  M1K2KZ  > for  any  zione  in  region, 

= 0 otherwise  _________________ 


Filler  to  make  a 25  word  block  for  writing 


onto  CASDSF 
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COMMON  STORAGE  ALLOCATION  ' • 


K&me  DSBT9 Size  9 Piage 1 of — i 

Fane t i OR  Data  Set  9 (at  Country  level) 


Name 


Dimen- 

sion 


For- 

mat. 


Description 


Sym- 

bol 


Units 


COUNTR 


W7AC2 


EC 


M1K2KC. 


AMLVe 


1 

1 


A6 


Country  ID 


Group  1,  2 Historical  WA 


Niunber  of  group  1,  2 segments  in 
country 


Analytic  area  variance 


WA. 


M. 


1C 


ha 


ha 


M1M2ZC 


Group  1,  2 substrata  flag: 

- 1 if  M1k2KZ>1  for  any  zone  in  country 


HWACl 


El-IACl 


= 0 otherwise 


Historical  wheat  area  (Group  1,  2) 


Estimated  wheat  area  (Group  1,  2) 


WA 


1,2 


WA 


1/2 


ha 


ha 


Note:  HWAC2  = S HWAZ2 

HWACl  = S HWAZl 


over  all 


ESTVC 


DSET9 


EWAC2  = S EWAZ2 
EWACl  = S EWAZl 


zones 


Group  1,  2 variance  estimate 


Data  Set  9 


Note: , DSET9  is  equivalenced  to  COUNTR 


ha 


9 


' 28234-6029-RtJ“51r 
Page  182  . . • 

COMMON  STORAGE  ALLOCATION 


Name  DSETlO Slae  20  I^ge 1 — of — 2 


Data  Set  10  (Strata  DSfa  - Second  Pass ) 


. 

Name 

Dimen- 

sion 

Fo'r- 

inat 

"Description 

Sym- 

bol 

Units 

HWAS 

1 

F 

Historical  WA 

ha 

TWAS 

1 

F 

True  WA 

WAg 

ha 

■EWAS 

1 

F ■ 

Estimated  WA  ' • - 

WAg 

ha 

AERRS 

1 

F 

Area  error 

mm 

ha 

AVARS 

1 

F 

Area  variance 

ha^ 

F 

True  production 

PKBs 

Quintals 

EPRODS 

F 

Estimated  production  • * 

P^g 

Quintals 

PRERRS 

1 

F 

Production  error 

EPs 

Quintals! 

•PRVARS 

1 

F 

Production  variance 

/s 

ypRg. 

Quintalsl* 

YS 

1 

F 

True  yield 

Quintals 

ha 

ESTYS 

1 

F 

Estimated  yield 

Quintals j 
ha 

YERRS 

1 

■ 

Error’  in  yield 

Quintals! 
ha  I 

MlJS 

1 

Number  of  group  I segments  in  strata 

bsi 

• j 

COMMON  STORAGE  ALLOCATION 
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DSETlO 


Size 


• 20 


P&ge  ^ of ^ 


Function  Data  Set  10  (Strata'.Pata  - Final  Pass) 


Units 

bol 


COMKON  STOE'^GE  ALLOCATION 
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Hsme 


DSETll 


Size  19 


Page  ^ of. 


Function  Data  Set  11  (Zone  Data  - Final  Pass) 


- Name 


Dimen-  I For- 


Description 


Sym- 


AVARZ 


TPR^DZ 


Estimated  productioa 


Production  error 


Production  variance 


ANAVZ 


True  yield 


Estimated  yield 


Yield  error 


Number  of  group  I segments  in  zone 


Number  of  group  II  segments  in  zone 


Number  of  group  I substrata  in  zone 


Number  of  group  II  substrata  in  zone 


Number  of  group  III  substrata  in  zone 


Analytic  area  variance 


uintals 


ha 


uintals 


ha 


2-8234-6029  “RU-.5.1- 
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COMMON  STORAGE  ALLOCATION 

• • 

• . - * . * 
jjame  PSETll, Size'  19  Page 2 — of_2 

* • . 

Function Data  Set  11  (Zone  Data  - Final  Pas s } 


1 


Name 

Dimen- 

sion 

For- 

mat 

Description 

Sym- 

bol 

Units 

ANPRVZ 

1 

F 

Analytic  production  variance 

IH 

DSETll 

19 

F 

Data  Set  11 

« 

Note:  DSETll  is  equivalenced  to  HWAZ 

C02^M0N  STORAGE  ALLOCATION 
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Name  DSET12 


Size  ' 19 


P&ge  1 of  2 


Function  Data  Sef  12  (region  data-final  pas ^ 


For- 

niat 


Description 


Historical  WA 


F 1 True  WA 


F ! Estimated  WA 


F 1 Area  error 


F I Area  variance 


True  production 


F I Estimated  production 


F I Production  error 


Sym- 

bol 


Units 


AKAVR 


F Production  variance 


F 1 True  yield 


F I Estimated  yield 


F Yield  error 


F I Number  of  group  I segments  in  region 


F Number  of  group  II  segments  in  region 


F 1 Number  of  group  I substrata  in  region- 


F Number  of  group  II  substrata  in  region 


F Ntmber  of  group  III  substrata  in  region 


F 1 Analytic  area  variance 


uintals 


ha 


uintals 


COMMON  STORAGE  ALLOCATION 
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DSET13 


Size 


Fvinction  Data  Set  13  (country  level -final  pas  s ) 
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Page  1 of ^ 


Dimen- 

sion 

For- 

mat 

Description 

Sym- 

bol 

Units 

i 1 

F 

’ 

Historical  WA 

WAc 

ha 

True  WA  


Estimated  WA 


F Area  error 


Area  variance  ' 


True  production 


Estimated  production 


production  error 


Production  variance 


True  yield 


Estimated  yield 


Yield  error  ‘ 


No,  of  group  I segments  in  country 


No.  of  group  II  segments  in  country 


No.  of  group  I substrata  in  country 


No.  of  group  II  substrata  in  countr 


No.  of  group  III  substrata  in  country 


Analytic  area  variance 


Quintals 


PRDc  Quintals 


EPq  Quintals 
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Name  DSET13 Size 25  Page  2 of  2 

Function  Data  Set  13  (country  level-final  pa s s ) 


Name 

Dimen- 

sion 

For- 

mat 

Description 

IlSi 

Units 

' 

ANPRVC 

1 

F 

Analytic  production  variance 

in 

HI 

CLEWA 

1 

F 

Confidence  level  about  estimated  WA  using 

CL  WA 

estimated  variance. 

CLEPRD 

1 

■ 

Confidence  level  about  estimated  production 

XX 

CL. PRD 

■ 

using  estimated  variance. 

HB 

1 

F 

Confidence  level  about  true  WA  using 

CL  WA 

- 

estimated  variance. 

true/est 

CLPTEC 

, 1 

F 

Confidence  level  about  true  production 

CL  PRD 

using  estimated  variance. 

mi 

CIATWC  1 F Confidence  level  about  true  WA  using  within  CL  WA 
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Name  CLSTAB Size  2724  • Page_ 

Function  Contains  tables  necessary  to  determine  class  sets  within  a zone. 


Name 


Dimen- 

sion 


For-  ' 
mat 


'Description 


ISTRAT  300 


ISBSTR  300 


300 


IGROUP  300 


IDATl 


XORD 

300 

IXPT 

300 

lEPT 


MAXCLS 


ICLCNT 


IRANK  300 


ISUBl 


NACQ 


Contains  strata  ID  for  all  strata  in  a zone 


Contains  substrata  ID  for  all  substrata  in 
a zone 


No.  of  acquired  segments  for  each 
substrata 


Group  no.  assignment  for  each,  substrata 


Variable  usage.  Set  to  AREAK  in  CLASSN 
for  use  by  SEGTAB.  SEGTAB  resets  it  to 


first  subscript  PTR  into  XORD  for  each 
substrata  segment  set  = DATl  (used  by  ASS( 


Variable  usage.  Set  to  HISTPW  by  CLASSN 
for  use  by  SEGTAB.  ASSCLS  puts  the 


assigned  class  number  for  each  substrata 
= DAT2 


Ratio  for  each  substrata  used  to  determine 
class 


Sorted  pointers  into  XORD  (in  ascending 
order) 


For  each  class  the  beginning  subscript  in 
XORD  (found  indirect  via  IXPT  lookup) 


For  each  class  the  ending  subscript  in 
XORD  (found  indirect  via  IXPT) 


Maximum  no.  of  classes  allowed 

= (10-1) 


Actual  count  on  number  of  classes 


Table  of  gap  rankings  of  sorted  X.  for  each  ^ , 

substrata  in  a zone  ^ -rank 


Count  of  no.  of  substrata  in  zone 


No.  of  acquired  segments  in  a zone 
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NaiHG  IXSU  BH  Siz6  2 Page  of 

Fimction  Index  information  for  ISUBH2  file 


Naine 


LIXSSH 


Dimen- 

sion 


For- 

mat 


Description 


Sym- 

bol 


Units 


Length  of  index  record  for  substrata  inter- 
mediate  file  (=  3202) 


Index  record  for  substrata  intermediate 
file  - ISUBH2 


IXSUBH 


I 
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Name  FILESI  Size  3 Page  of 

Function ' 


Name 

Dimen~ 

sion 

For- 

mat 

* i 

Description 

Sym- 

bol 

Units 

SEGID 


LSEGID 


CROPW 


LCROPW 


SUBHST 


LSUBH 


ACQUIS 


LACQ 


CAMSF 


LCAMSF 


CAMERR 


LCAMER 


CASE 


LCASF 


yes«5ut 


LYES0 


LSIGEX  • 


I Logical  file  number  for  segment  ID  file- 


I Record  length  for  segment  ID  file 


I Logical  file  number  for  Crop  Window  file 


Record  length  for  Crop  Window  file 


I Logical  file  number  for  Substrata  Historical 


J-X 

I Record  length  for  Substrata  Historical  file 


I Logical  file  number  for  Data  Acquisition  file 


I Record  length  for  Data  Acquisition  file 


I Logical  file  number  for  CAMS  Output  file 


1 I Record  length  for  CAMS  Output  file  


I Logical  file  number  for  CAMS  Error  Model  file 


I Record  length  for  CAMS  Error  Model  file 


Logical  file  number  for  CAS  Cumulative  Output  file 


I Record  length  for  CAS  Cumulative  Output  iile 


Logical  file  number  for  YES  Output  file 


1 I Record  length  for  YES  Output  file 


1 I Logical  ’file  number  for  Signature  Extension  f 


1 I Record  length  for  Signature  Extension  file 


..28234-6029-RU-00 
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Name  FILES Size  30  Page___£_  of ^ 

Function  File  Definitions  and  Record  Lengths 


Description 


I I Logical  file  number  for  YES  Error  Model^il^ 


I j Record  length  for  YES  Error  Model  file 


I Logical  file  number  for  Segment  Truth  file 


LCASDS 


I { Record  length  for  Segment  Truth  file 


I [Logical  file  number  for  CAS  Distribution  Outp 


Record  length  for  CAS  Distribution  Output:  fil 


I Logical  file  niomber  for  input  file 


Logical  file  number  for  output  file 


I Logical  file  number  for  CAMS  scratch  file 


I [Record  length  for  CAMS  scratch  file 


I I CAS  Intermediate  file 


I Record  length  for  CAS  Intermediate  file 
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Name 


IXCASF 


Size  389 


Page„ 


of  I 


Function  Record  for  CAS 

Cumulative  File  (CASF) 
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' . IXDISF  Size  113  Page_L__  o'f_P 

Function  Record,  for  CAS  Distribution  file  (CASDIS) 
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LEMCM 


Size 


Page  1 of ^ 


Function  Control  Card  Input  Data 


Diir.jn-  1 For- 


Description 


Problem  header  printed  at  the  top  of  each  page 


Case  number 


Number  of, Monte  Carlo  iterations  at  end  of  rxjn 


=n  5^0  to  restart  after  n 
Monte  Carlo  iterations 


Print  flag  for  segment  truth 


= 0 to  print  first  and  last  iterations, 

= 1 to  print  every  iteration, 


= 2 to  print  last  iteration, 

= 3 to. skip  printing.  


Starting  region  number 


Starting  zone  number  


Ending  region  number 


Ending  zone  number 


Segment  Truth  Generator  Error  flag: 


= 0 to  vary  error, 

= 1 to  hold  error  constant  using  first 


iteration  results  throughout  run, 

= 2 to  hold  error  constant  using  a previously 


= 3 to  eliminate  error  (error  is  zero) 


COMON  STORAGE  ALLOCATION 
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Name  LEMCM Size 

Function  Control  Card  input  Data 


Page  ^ of  ^ 


For- 

mat 

Description  j 

Sym- 

bol 

j 

1 Units 

(Use  is  similar  to  use  of 
CAMS  Error  Flag;  ISTG  described  above) 


(Use  is  similar  to.  use  of 
YES  Error  flag:  ISTC  described  above) 


Segment  Acquisition  flag 


=0  to  include  segment  acquisition  conditio 
=1  to  eliminate  segment  acquisitiqn  condit 


Classification  Error  flag; 


■ = 0 to  vary  classification  error, 
= 1 to  hold  error  constant. 


= 2 if  error  is  zero. 


Signature  Extension  error; 


= 0 to  vary  error, 

= 1 to  hold  error  constant. 


= 2 if  error  is  zero. 


Segment  Crop  Calendar  error; 


= Q to  vary  error, 

= 1 to  hold  error  constant, 


= 2 if  error  is  zero. 


CAS  Group- II  Error  flag: 


= 0 to  vary  error, 

= 1 to  hold  error  constant. 


= 2 if  error  is  zero. 


CAS  Group -III  Error  flag; 


= 0 to  vary  error, 

= 1 to  hold  error  constant, 


= -2  if  error  is  zero. 
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Name  LEMCM 


Size  57 


-?age_ 


Punct i on  LEM  Control  Card  Input  Data 


Name  - 


Dimen- 


Description 


Units 


IPRCAM 


Print  flag  for  CAMS 


- 0 to  print  report  on  first  and  last  iterations^ 
= 1 to  print  every  iteration. 


= 2 to  print  last  iteration  only, 
= 3 to  suppress  printing. 


Print  flag  for  YES 


(similar  to  IPRCAM) 


print  flag  for  CAS 


(similar  to  IPRCAM) 
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Name  LEMCM 


Size  57 


Page  ^ of  ' ^ 


Function  Control  Card  Input  Data 


Units 


ICSECW 


ICSESH 


ICSECE 


ICSEYM 


I Case  number  for  YES  Data  file 


I Case  number  for  Signature  Extension  file 


Case  number  for  Data  Acquisition  file 


DP  Initial  random  number  seed  for  Segment  Trutl 


Erro: 

DP  Initial  random  no.  seed  for  Classification 


DP  Initial  random  no.  seed  for  Signature  Ext. 


Initial  random  number  seed  for  segment 
DP  Crop  Calendar  Error  • 


Initial  random  no.  seed  for  yield  error 


Initial  random  no,  seed  for  CAS 
Group  II  Error 


Initial  random  number  seed  for  CAS  Group  Ii; 
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Name  LEMCM 


Size  57 


Function  LEM  Control'  Card  Input  Data 


Dimcn- 


Description 


Sym- 


ICSEST 


ICSECei 


ICSEYS 


ICS ECU 


ICSECD 


I Case  number  for  Segment  Truth  File 


I Case  number  for  CAMS  Output  file 


I j Case  number  for  YES  Output  file 


I . Case  number  for  CAS  Cumulative  Output  file 


I Case  number  for  CAS  Distribution  Output  fil 
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Name  FAGECM Size  14  Page  ^ of 

Fimction  Common  Quantities  for  PAGER 


COMON  STORAGE  ALLOCATION. 
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Kaone  ® EGDTA 


Size  20 


Page  1 of  1 


Function  Segment  -Data  From  CAMS  File 


Dim'  n- 


Descriptior. 


Country,  region,  zone,  strata,  and 


substrata  ID's  for  current  segment, 


I Segment  ID 


F True  PW  for  segment 


(converted  to. fraction  from  %) 


I I Zulu  Acquisition  day  for  4 windows 


K ■ 

F Estimated  PW  for  this  segment  for  4 windows 


(converted  to  fraction  from  %) 


Error  in  PW  estimate 


Estimated  PW  for  this  segment  for  current 


window,  ESTPWI  = EPWKI  (WINDgJW) 


C0UW2 


IREG 


IZ0NE2 


ISTRA2 


ISUBS2 


IDS  EG 


GRPN?5 


" t 

HISTPW 


MGR 


M 


DELTPW 


DELTPM 


CVl 


Description 


A6  Country  ID 


Region  ID 


I Zone  ID  ' • ' 


I Strata  ID 


I Substrata  ID 


I Number  of  segments 


List  of  sample  segments  in  this  substrata 


Group  number 


Historical  PW  for  substrata 


(fraction  converted  from  %) 


Land  area  of  the  substrata 


(in  ha'  converted  from 
True  PW  for  substrata 


(fraction  converted  from  %) 


I No.  of  agricultural  segments  in  substrata 


I No.  of  allocated  segments  in  substrata 


F Bias  of  true  PW 


F Ratio  of  true  mixed  pixels 


Coefficient  of  variation  for  year  to  year 


change  in  PW 


Sym- 

bol 


Units 


COMiCW  STORAGE  ALLOCATION 
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Name  sshdta 


Size  20 


Function  Substrata  Historical  Data  from  SUBHST 


Description 


C0MI40N  STORAGE  ALLOCATION 
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Name  SIATS 


Size 


Page. 


Fimction  Statistical  information  for  LEM 


Dimen- 


Description 


Current  Monte  Carlo  iteration  number 


Number  of  data  records  written  onto  the 


Segment  Tfuth  file 


Number  of  data  records  written  onto. the 


CAMS  Output  file 


Number  of  data  records  written  onto 
the  YES  Output  file 


Number  of  data  records  read  from  the  input  ^iles 


1 = Segment  ID  file ■ 

2 = Crop  Window  file 


= Substrata  Historical  file 
= CAMS  -Error  Model  file 


j = YES  Error  Model  file 
) = Signature  Extension  file 


7 = Data  Acquisition  file 


Number  of  data  records  written  onto  the 
CAS  Ctimulative  file 


Number  of  data  records  written  onto  the 
CAS  Distribution  file 


Equivalenced  to  ITER 


COMON  STORAGE  ALLOCATION 


Name  STGDTA  Size  643 

Function  Data  for  Segment  Truth  Generator 
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Fage  I of  ' 3 


■ Name 

Dimen- 

sion 

For- 

mat 

Description  j 

Sym- 

bol 

Units 

COUN 


IREG 


izte 


ISTRAT 


IS  EG 


ITRAIN 


ITSPRL 


SL0NG 


ISW 


CCiuiC 


IREG2  • 


IZ25NE2 


ISTRA2 


ISUBS2- 


NS  EG 


A6  Country  ID  from  SEGID  file 


I Region  ID  from  SEGID  file 


I Zone  ID  from  SEGID  file 


I Strata  ID  from  SEGID  file 


I Substrata  ID  from  SEGID  file 


I Segment  ID  from  SEGID  file 


I 


I Training  Segment  Priority  List 


F Segment  latitude 


F Segment  longitude 


I Grid  number 


A6  Country  ID  from  SUBHST  file 


I Region  ID  from  SUBHST  file 


I Aone  ID  from  SUBHST  file 


I Strata  ID  from  SUBHST  file 


I Substrata 'ID  from  SUBHST  file 


I , Number  of  segments  in  substrata 


radians 
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Name  STGDTA 


Size  6^3 


of  '3 


Function  Data  for  Segment  Truth  Generator 


Name  • 


Dim?  n- 


For- 

mat 


Description 


IDSEG 


GRPNgi 


HISTFW 


DELTPW 


DELTPM 


AVEPW 


SUMPW 


I List  of  sample  segments  in  substrata 


I Substrata  Group  ntimber 


F Historical  proportion  wheat 


F Substrata  land  area 


F True  proportion  wheat 


I Number  of  agricultural  segments  in  substrata 


I Number  of  allocated  segments  in  substrata 


F I Bias  of  true  PW 


Ratio  of  true  mixed  pixels 


Coefficient  of  variation  for  year-to-year  ch 


Coefficient  of  variation  for 
within  county  variation  of  PW 


Coefficient  of  variation  for 
within  county  variation  of  PM 


Coefficient  of  variation  of 
multi-year  historical  WA 


True  proportion  wheat  for  segment  i 


F True  proportion  mixed  pixels  for  segment  i 


F Average  segment  PW  for  substrata 


F • Sum  of  PW  for  all  segments  in  substrata 

ixX 


Number  of  segments  in  substrata 
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Name  STGDTA Size  643  Page  ^ of  3 

Function  Segment  Truth  Generator 


COMCSJ  STOPJIGE  ALLOCATION 
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Name  ■ SUMDTA 


Size_329 


Page  1 ofj^ 


Function  Summary  Data-  for  Reports 


Units 
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Name  '^ESD'EA  Size  21 Page  I of 1 

Function  Data  from  YESQUT  file 


• Name' 

Dimen- 

sion 

For- 

mat 

Description 

Sym- 

bol 

Units  ■ 

YSTR 

1 

F 

True  yield  for  stratum 

Hi 

Quintals 

ha 

IZPRDD 

6 

I 

Zulu  yield  data  for  up  to  six  prediction 

points 

YSCI 

6 

F 

Estimated  yields  for  the  six  prediction 

Quintals 

ha 

■ 

points 

. 

VSYCI 

6 

■ 

Variances  of  yield  for  the  six  prediction 

VYRg 

Quintals 

ha 

RDYES 

1 

I 

Flag  used  to  control  reading  YES0UT  file: 

- 

= 0 to  read  YES^iUT, 
^ 0 otherwise 

NYESPP 

1 

I 

No.  of  YES  prediction  points 

- 

- 

■ 

• 

for  one  stratum 

- 

— 

■ 

■ 

t 

. ' 

' 

* 

_ 
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ISUBH2  FILE 


SUBHST  scratch  file  for  CAS.  This  file  is  generated  from  the 
SUBHST  file  and  augmented  with  class  numbers  in  pass  0.  This  file  then 
is  used  in  place  of  SUBHST  in  subsequent  CAS  passes. 

Access  Method:  Direct  with  fixed  length  records  --  uses  FORTHAN  V 

direct  access  routines. 

Status:  Temporary,  regenerated  everytime  CAS  runs. 

Sort:  Country,  region,  zone,  strata,  then  substrata.  3201  records  max. 

Media:  Disk  - FASTRAND 

Record  Length:  39  words 

Recommended  Blocking  Factor:  5 

File  Size:  124,  839  words 


Record  Formats: 


Detail  Record 

COUN2  - 
IREG2  - 
IZON2  - 
ISTRA2  - 
ISUBS2  - 
NSEG 
IDSEG  - 
GRPNO  - 
HISTPW  - 
AREAK  - 
PWK 
NAGR 
NA 

DELTPW- 


See  SUBHST  file  definition 

ti 

M 

II 

It 

It 

Dummy  cell  (not  used  in  CAS) 
See  SUBHST  file  definition 
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Detail  Record  (cont'd) 


DELTPM  - 

CVl 

CV2 

CV3 

CV4 

VMULTK^- 

CLASS 

MXK 


See  SUBHST  file  definition 

II 

II 

It 

n 


1 word  fit.  pt. , variance  multiplier  in  hectares 

18  word  array  (integer),  class  no.  assignment  for 
each  of  up  to  18  prediction  points,  O-IO 

1 word  integer,  count  on  no.  of  acquired  segments 
(for  group  1/2  only),  0-300 


•Trailer  Record 

COUN2  - Contains  'ZZZZ'. 

The  remainder  of  the  record  contains  38  zeros. 


28234-6029-RU-00 
Page  210 


CAMS  COMMON  BLOCKS 
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i 

COMON  STORAGE  ALLOCATION 


Name  ACQUIS Size  Page  1 of i 

Holds  1 record  from  Data  Acquisition 
Fimct i on  File,  input  file  (ACQUIS^ ■ 


Name  CAMERR 


COMMON  STORAGE  ALLOCATION 
•Size  50 


Holds  !■  record  from  CAMS  Error 
Function  File,  itiput. file  (CAMERR) 
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Page  1 of ^ 


Name 

Dl’  \en- 
sion 

For- 

mat 

Description 

Sym- 

bol 

Units 

COUN2 


IREG2 


IZONE2 


ISTRA2 


ISUBST2 


ISEG2 


’PW 


Country  ID 


Region  ID 


Zone  ID 


Strata  ID 


Substrata  ID 


Segment  ID 


Probability  of  classif.  as  wheat, 


1st  dim.  = type  (given  wheat,  mixed, 
other 


2nd  dim.  = window 


Bias  error,  1st  and  2nd  dimensions  same 
as  above 


Std,  dev.  of  error,  1st  and  2nd  dimensions 
same  as  above 


COMON  STOPAGE  ALLOCATION 
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Name  CAMSF 


Size  19 


Page  1 of  1 


Function  Holds  I record  for  CAMS  Output  File 


'ROTODUCBILITY  of  the 
ORIGINAL  PAGE  IS  POOR 


Name  CROPW 


■COLMON  STORAGE  ALLOCATION 


Size  33 


Holds  1 record  from  Crop  Calendar 
Function  File,  input  file  (CROPW) 
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Dinen-  iFor- 


Description 


COUN3 


Country  ID 


Region  ID 


Zone  ID 


Strata  ID 


Substrata  ID 


Zulu  date^  start  of  window, 


dim.  i = season  (winter,  spring) 
dim.  2 = window 


END 


2,4  I Zulu  date,  end  of  window 


Std.  dey.  of  seg.  cal.  error  0 — 99 


COMI-ION  STORAGE  ALLOCATION 
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■Name  ERROR 


Size  40 


Page  1 of ^ 


Fimction  Values  for  CAMS  repo r fc 


Dimen- 


Description 


IDATE 


TRAINA 


TRAIND 


Window  title 


Acquisition  date 


Estimated  proportion  of  wheat  '' 


Total  error 


Ordinary  segment  error  without  signature, 
extension  error 


Total  error 


Total  bias  error,  dimension  = type  (wheat, 
mixed,  other), 


Total  random  error 


Classification  error- 


Classification  bias  component  ' 


Classification  random  conponent- 


Qrop  calendar  error  factor 


Crop  calendar  error  factor 


Signature  extension  error  factors, 
dimension  Z = Z1  or  Z2 


Multi- 


Segment  ID  of  training  segment  correl, 
w/ordinary  - 


% agreement  - training  w/ordinary 


()  disagreement  - training  w/ordinar 


COMON  STORAGE  ALLOCATION 
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, Name  INDX ■ Size  1003 

Index  to  scratch  DA  file,  TACQ, 
Funct ion  pl^s  index  to  index 


Description 


Sym- 


INDEX  I 2000 


IPOINT  2001 


IPNT2  2001 


Index  to  TACQ  {needed  for  CPC  version) 


Index  to  IPNT2 


Index  to  INDEX 


Pointer  to  last  word  of  IPOINT  filled 


Pointer  to  last  record  read,  in  IPOINT 


Indexing  works 


given  ISEG  = segment  ID 


binary  search  of  IPOINT  to  find  N where 


IPOINT(N)  = ISEG 


then  IPNT2(N)  = IN 


where  IN  = record  no.  of  record  on  TAG 
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COMON  STORAGE  ALLOCATION 


Name  SEGTRU  ■ Size  16 Page  1 of  1 

Holds  1 record  from  Segment  Truth 
Function  File,  input  file  (SEGTRU) 


Dimen- 


Description 


COUN4 


Country  ID 


Region  ID 


Strata  ID 


Substrata  ID 


Segment  ID 


0 = ordinary  segment,  1 = training  segmen 


■Priority  list  = segment  nos. 


0 = winter,  1 = spring 


True  proportion  of  wheat 
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COMON  STOMGE  ALLOCATION 


Name  SIGEX Size  59 Page  1 of  '1 

Holds  1 record  from  input  file, 

Fxmction  Signature  Extension 


COI^MON  STOft'vGE  ALLOCATION 
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Name  T RAIN  S 


Size  1032 


Function  Holds  training  segments  - I actual  record  of  scratch  DA  file  TACQ 
(same  as  ACQUIS  file  record  + extra  information)  + information, for 
CAMSF  record 


Di)  len- 
sion 


^591 

S 


Description 


Sym- 

bol 


ITTOT 


TMM  3,  4,  25 


3,  4,  25 


3,  4,  25 


TBB 


TVV 


TP TRUE 


TIZULU  4 


TPEST 


TPERR 


TERTOT  3 


Countrv  ID 


Reeion  ID 


Zone  ID 


Strata  ID 


Substrata  ID 


Segment  ID 


Up  to  25  acquisition  dates 
for  4 windows 


Total  no.  acquisition 
dates 


M values  (multi- temporal 
error) 


Bias  values 


Variance  values 


True  proportion  wheat 


Acquisition  dates 


Estimated  proportions  of 
wheat 


Error  in  estimates 


from  ACQUIS 


record 


saved  from 
CAMS 


calculations 


for  (CAMSF) 


Error  total  - calculated^ 

1 needed  for 
calculations  - 

from  TM,  TB,  TV  J 

f not  part  of 
1 TACQ  record 
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File  Description 


CAMS  DA  SCRATCH  FILE  - TACQ 

This  file  .is-  generated  in  CAMS  to  store  training  segment  information 
to  use  .ater  in  CAMS„' 

Access  Method:  Direct  with  fixed  length  records  - uses  FORTRAN  V 

direct  access  routines. 

Status:  Temporary,  regenerated  everytime  CAMS  run. 

Sort:  By  I,  1=1,  2000  for  up  to  2000  training  segments.  These  are  indexed 
by  segment  ID  in  array  IPOINT,  COMMON  /INDX/ , then  array 
IPNT2  to  get  the  actual  index. 

Media:  Disk  - FASTRAND 

Record  Formats:  No  header  or  trailer. 

Record  Length:  1020  words 

Blocking  Factor:  1 

File  Size:  2,  040,  000  words,  assuming  a maximum  of  2000  training  segments. 
Detail  of  1 Record:' 

Country  ID  - 4 bytes,  4 alpha  characters 
Region  ID  - 1 word  integer,  3 digit  no. , I to  10 
Zone  ID  - 1 word  integer,  3 digit  no. , 1 to  100 
Strata  ID  - 1 word  integer,  4 digit  no,,  I to  500 
Substrata  ID  - 1 word  integer,  4 digit  no.  , 1 to  3200 
Segment  ID  - 1 word  integer,  5 digit  no.  , 1 to  4000 
For  each  of  4 Crop  Windows: 

25  entries  for 

Acquisition  Date  - 1 word  integer,  Zulu  date 
Total  No,  of  Accesses  - 1 word  integer,  3 digit  no. 
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Multi- temporal  error  factors: 

for  wheat  - 1 word,  floating  point,  0-1 
for  mixed  - 1 word,  floatingpoint,  0-1 
for  other  - 1 word,  floating  point,  0-1 
Bias  error  factors: 

for  wheat  - 1 word,  floating  point 
for  mixed  - 1 word,  floating  point 
for  other  - 1 word,  floating  point 
Variance  error  factors: 

for  wheat  - 1 word,  floating  point 
for  mixed  - 1 word,  floating  point 
for  other  - 1 word,  floating  point 
True  proportion  of  wheat  this  segment,  fit.  pt. , % 0-100 
Zulu  Acquisition  Day  - 1 word  integer  (zero  for  no  acquisition) 
Estimated  Proportion  of  Wheat  - Flt»  pt. 

Error  in  Proportion  of  Wheat  Estimate,  fit,  pt. 


One 

ordered  set 
for  each  of 
4 windows 
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YES  COMMON  BLOCKS 


CO?®ON  STORAGE  ALLOCATION 

Nsjiis  YE  SOT  Size 

Function  One  record  of  YES  output  file 
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Page  1 of ' 1 


IREGID 


IZONID 


YSTR 


YSCI 


VSYCI 


For- 

mat 

Description 

R 

4 character  country  ID 

I 

Region  ID  1-10 

I 

Zone  ID  1-100 

I 

Strata  ID  1-500 

Real 

True  yield,  range  0-99.99 

I 

Zulu  prediction  date 

Real 

Estimated  yield,  range  0-99.99 

Real 

Standard  deviation  of  yield  error, 
range  0-99. 99 

Sym- 

bol 


Quintals 


Hectare 


Hectare 


Hectare 
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COMON  ST0RA.GE  ALLOCATION 

YESIN  Size Page_J___  of_l 

Fionction  Store  record  from  YES  input  file 
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LOCAL  STOTiAGE  ALLOCATION 

Name  YES  Size  Page  1 of 1 

Function  
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PART  III 

LIST  OF  SUBROUTINES  AND  SUBROUTINE 
CALL  STRUCTURE 
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LEM  Subroutine  Call  Structure 

LEM 

START 

INPUT 

ERRMES 

INPCHK 

ERRMES 

ft 

EJECT 

CAMSIN 

EJECT 

ERRMES 

PAGER 

CASIN 

EJECT 
ERRMES 
PAGER 
INPERR 
GAMERS 
C A SERI 
CAMER2 
CASER2 
SIGERR 
WRAPUP 

RANACF 

EJECT 

LFPA 
RANACF 
PAGER  ’ 

INIT 

ERRMC 

SETPRF 
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STG 

ERRMES 

BETAD 

RDMIA 

IBETAI 

ALGAMA 

CAMS 

EJECT 

INITI 

ERRMES 

TSAVE 

RANACF 

ERRMES 

SORTAG 

INPT 

ERRMES 

TSAVE 

REPORT 

PAGER 

FZULU 

MULTI 

CROP 

BETAD 

CLASS 

BETAD 
TSAVE 
CORREL 
TSAVE 
SGEXT  ’ 

BETAD 

ERRMES 

YES 

ERRMES 

EJECT- 

FZULU 

PAGER 

BETAD 


28234-6029-B.U-00 
Page  229 


CAS 

CASPP 


CLASSN 

SEGTAB 
DETCLS 
■ ASSCLS 
CASINL 


GETYS 


. ERRMES 
ERRMES 
DS123 


ERRMES 

GROUP 

ERRMES 
BE  TAD 
DS456 

RANACF 

DS7 

RANACF 

RANACF 

CAS2 

PAGER 

< 

RANACF 

DSIO 

RANACF 

RDMIA 

ERRMES 

RWCASF 

RANACF 

CASOUT 

APHDR 

EJECT 

• • PAGER 

CONFL 
RWCASF 
RWDISF 

ERRMES 

RANACF 

CASOUT 

DS18 

YSUB 


CASS 
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CASPP  (cont'd) 
SUMREP 
EJECT 
PA  GER 

WRAPUP 

RANACF 

EJECT 
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PART  i‘y 

SUBROUTINE  DESCRIPTION 
AND  FLOWCHARTS 


List  of  Subroutines  in  LEM 
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Name 

Function 

1. 

LEM 

Main  di'.iver  for  LACIE  error  model. 

2, 

EJECT 

Restores  page  and  prints  the  page  header. 

3, 

ERRMC 

Initializes  the  random  number  seeds  for  each  error 
source. 

4», 

ERRMES  - 

Controls  the  printing  of  all  error  messages  for  LEM, 

5. 

FZULU 

To  convert  Zulu  date  to  year,  month  and  day. 

6. 

PAGER 

Automatic  paging  control  routine. 

> 

7. 

RANACF 

Standardized  random  access  I/O  routine. 

8. 

SETPRF 

Controls  the  printing  of  reports  by  subprogram  and 
module. 

9. 

CASIN 

This  routine  reads  in  and  checks  the  CAS  control  cards. 

10. 

CASERl 

This  routine  contains  the  input  error  messages  for  CAS. 

11. 

INIT 

Initializes  random  number  seeds. 

12. 

INPCHK 

* 

Checks  the  validity  of  the  input  parameters  on  the  LEM 
control  cards  and  checks  the  header  records  of  all  input 
files  for  valid-case  numbers. 

13. 

INPERR 

Prints  error  messages  for  the  LEM  input  processor. 

14. 

INPUT. 

Reads  and  checks  LEM  control  card  input  and  controls 
reading  of  all  other  data  cards. 

15. 

< 

LFPA 

Given  month,  day  and  year,  this  routine  returns  the  Zulu 
date. 

16. 

START 

Initializes  storage,  flags  and  counters. 

17. 

STG 

Segment  truth  generator  subprogram  for  LEM, 

18. 

WRAPUP 

■ This  routine  writes  header  records  on  CAS  output  files 
and  prints  status  information  at  end  of  run. 

19. 

STGERR 

Prints  error  messages  for  the  segment  truth  generator. 

20. 

CAMSIN 

Reads  and  checks  CAMS  control  cards. 

28234-6029-RU-00 
Page  233 


Name 

Function 

21.  • 

CAMSERS 

Prints  out  CAMS  conti’ol  card  error  messages. 

22. 

BE  TAD 

Controls  the  calculation  of  the  incomplete  beta  function. 

23. 

IBETAI 

Computes  the  incomplete  beta  func  ion  integral. 

24. 

AEGAMA 

. Computes  the  gamma  function. 

25, 

RDMIA 

Uniform  random  number  generator  CAMS  subprogram 
subroutine  set. 

26. 

CAMS 

Driver  for  the  CAMS  subprogram  Which  calculates  the 
estimated  proportion  of  wheat. 

27. 

REPORT 

■Prints  the  CAMS  report. 

28. 

INITI 

This  routine  initializes  the  input  files  and  output  files. 

29. 

CORREL 

This  routine  tries  to  correlate  a training  segment  with 
the  ordinary  segment  being  processed. 

30.  . 

MULTI 

This  routine  calculates  the  multi-temporal  error  for 
training  segments. 

31. 

SGEXT 

This  subroutine  calculates  the  signature  extension  error 
for  ordinary  segments. 

32. 

CROP 

This  subroutine  calculates  the  crop  calendar  error  for 
training  segments. 

33, 

TSAVE 

This  subroutine  handles  the  I/O  for  the  scratch  RA  file 
TACQ  for  CAMS. 

34-. 

CLASS 

This  subroutine  calculates  the  input  clc  ssification  error 
for  training  segments  and  the  total  classification  error. 

35. 

INPT 

This  subroutine  gets  the  next  set  of  records  to  process 
from  the  input  files. 

36. 

CAMER2 

This  subroutine  contains  the  processing  error  messages 
for  the  CAMS  module. 

37.- 

YES 

This  subroutine  calculates  the  estimated  yield  from  the 
true  yield. 

38. 

CAS 

Main  driver  for  the  CAS  simulator. 

39. 

APHDR 

This  routine  prints  the  headers  for  the  area  and  pro- 
duction summary  report. 
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Name 

Function 

40. 

CASER.2 

This  routine  prints  the  processing  error  messages  for 
CAS  simulators. 

41. 

CASINL 

This  routine  performs  initialization  tasks  for  each 
prediction  point. 

42. 

C A SINT 

This  routine  performs  miscellaneous  tasks  for  the  CAS 
simulator. 

43. 

CASPP 

This  routine  performs  the  first  pass  CAS  computations 
generating  data  sets  1-9. 

44. 

CASOUT 

This  routine  prints  the  area  and  production  report  and 
saves  data  for  the  country  report. 

45. 

CAS2 

This  routine  generates  data  sets  10-17,  19,  using  data 
sets  1-9  read  from  the  CAS  intermediate  file. 

46. 

CONFL 

This  routine  computes  the  confidence  levels  in  data  set  13. 

47. 

DS123 

This  routine  processes  data  sets  1,  2 and  3 at  the  sub- 
strata level. 

48. 

DS456 

This  routine  processes  data  sets  4,  5 and  6 at  the  strata 
level. 

49. 

DS7 

This  routine  processes  data  set  7 at  the  zone  level. 

50. 

DSIO 

This  routine  processes  data  set  10  at  the  strata  level. 

51. 

.DS18 

This  routine  computes  CLWA  and  CLPRD  in, data  set  18 
on  the  final  iteration. 

52. 

GETYS 

This  routine  reads  strata  data  from  YESOUT  file  and 
obtains  the  proper  value  of  estimated  yield  for  the  current 
bio -window  or  prediction  date. 

53. 

GROUP 

•This  routine  reads  segment  data  from  the  CAMS  output 
file,  selects  the  e stimated  proportion  wheat  for  the  proper 
bio-window  for  each  segment,  and  aggregates  the  segment 
- data  up  to  the  substrata  level. 

54. 

PSUB 

This  function  computes  function  P(X)  for  confidence  level 
calculations. 

55. 

RWCASF 

This  routine  reads  a data  set  from  the  CAS  cumulative  file 
or  writes  a data  set  onto  the  CAS  cumulative  file. 

56, 

RWDISF 

This  routine  reads  and  writes  data  from /onto  the  CAS 
distribution  file. 
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Name 

Function 

57. 

SUMREP 

This  routine  prints  the  CAS  country  summary  report. 

58. 

TSUB 

This  routine  computes  the  quantity  T from  Equation  39. 

59. 

YSUB  ^ 

Tins  function  computes  the  quantity  Y used  in  the  con- 
fidence level  calculations. 

60. 

CIoASSN 

Tills  routine  controls  the  computation  of  class  numbers 
for  all  zones. 

61. 

SEGTAB 

This  routine  forms  the  segment  tables  to  be  used  to 
determine  class. 

62. 

DETCLS 

This  routine  determines  how  many  classes  and  how 
many  data  points  in  each  class. 

63. 

ASSCLS 

This  routine  assigns  the  class  number. to  each  substrata 
in  a zone. 

64. 

CASS 

This  routine  generates  data  sets  10-19  on  final  pass. 
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SUPPLIED  UTILITY  ROUTINES 


Routine  Day 

Call  Day  (lYMD,  IDAY) 

Given  lYMD  (3)' where  lYMD  (1)  IS  Day  No. 

lYMD  (2)  IS  Month  No. 

lYMD  (3)  IS  Year  No- 

Compute  year  day  no.  in  IDAY 
Routine  PIMOD 

Call  PIMOD  (A) 

Convert  ±A  in  radians  to  an  angle  O-Zir 

Routine  SOL  (Entry  ALPHA) 

Call  ALPHA  (IF  LAG)  . 

For  emphemeris  usage  as  called  by  hector 

computes  ALPHAM  and  ALPHAT  and  IFLAG  = 1 

Routine  PAGER  (Entry  Eject) 

Call  PAGER  (NLINES) 

Updates  line  count  in  NLINE  with  NLINES 

NPAGE  = 0 causes  page  to  be  restored  prior  to  print. 

NPAGE  - page  no. 

HEADER-  80  char.  20A5 
ICASE-  case  no. 

KO  - 6 print  unit 

IN  MAX  is  max  no.  of  lines  allowed 

Initially  NLINE  should  be  set  > LINMAX  and  NPAGE  = 0 


28234-6029-RU-00 
Page  237 

SUPPLIED  UTILITY  ROUTINES 
.(CONTINUED) 

Call  EJECT  (NLINES) 

Sauses  page  to  be  restored  automatically  and  then  prints  headers. 
Routine  CLDAY 
Call  CLDAY 

Given  IDAY-DAY  no.  o£  the  year  compute  in  LMO-the  month 
and  in  LDA  the  day  no. 

Need:  lYEAR  = 0 - Leap  Year,  4-  0 not  Leap  Year 

Routine  KEPLER 

Call  KEPLER  (XM,  XECC,  XE,  ERROR) 

Given  XM  - Mean  anomaly,  XECC  - eccentricity 
Compute;  E-ecccntric  anomaly  error  = 0 means  .OK 

Routine  LFPA 

Call  LFPA  CflDA,  LMO,  LYR,  ALFGM  (can  be  dummy),  DAYsJ 

Given:  FLDA  - day  of  month  no.  , LMO  - month  no.  , 

LYR"  - year  no.  compute  ALFGM  - right  ascension  and 
DAYS  - Zulu  day  no. 

Routine  DEG  MOD 

Call  DEGMOND  (RAD,  IDEG) 

Given:  angle  rad  in  radians  store  the  angle  in  deg.,  min.,  sec., 
in  IDEG(i]  - (3). 

Routine  FZULU 

Call  FZULU  (lOATE,  lOUT) 

Given  Zulu  date  in  IDATE,  compute  year,  month  and  day  in 
lOUT(l)  - 10UT(3). 

Routine  RDMXA 

Call  RDM1A.(FL,  U) 

Given  double  precision  random  no.  seed  in  FL,  comoute  random 
no.  U (0-1)  based  on  uniform  distribution. 
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SUBROUTINE  LEM 


Purpose: 

Tlie  subroutine  LEM  is  the  main  driver  for  the  LEM  program.  It 
defines  all  global  common  blocks  used  in  the  LEM  program  and  calls  the 
drivers  for  the  various  subprograms  within  LEM  {INPUT,  STG,  CAMS, 
YES,  and  CAS). 


Input; 


Output: 


Common 

Quantity 

Block 

Source 

N FATAL 

ARGLST 

INPUT 

STG 

CAMS 

YES 

CAS 

NTRIAL  ■ 

LEMCM 

INPUT 

RSTART 

LEMCM 

INPUT 

IPRINT 

LEMCM 

INPUT' 

ISTG 

LEMCM 

INPUT 

ICAMS 

LEMCM 

INPUT 

lYES 

LEMCM 

INPUT 

IPRCAM 

LEMCM 

INPUT 

IPRYES 

LEMCM 

INPUT 

IPRCAS 

LEMCM 

INPUT 

Common 

Quantity 

Bio  ck 

Destination 

NSTART 

CNTE.L  ■ 

CAS  and  related 

routines 

ITERS  NT 

STATS 

STG 

CAMS 

YES 

CAS 

and  related  routines 
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Linkage; 

LEM,  being  the  main  program  is  called  by  the  operating  system. 
Subroutines  Used; 


START 

SETPRF 

INPUT 

STG 

ERRMES 

CAMS 

INIT 

YES 

ERRMC 

CAS 

WRAPUP 

Processing: 

LEM  calls  START  to  initialize  a few  flags  and  counters,  then  calls 
INPUT  to  read  and  check  all  control  card  input  data.  If  any  fatal  input  errors 
are  detected  in  the  input  data,  subroutine  ERRMES  is  called  to  abort  the 
run. 


If  no  fatal  input  errors  are  detected,  then  subroutine  INIT  is  called 
to  initialize  the  random  number  seeds. 


Next  for  each  Monte  Carlo  iteration  (starting  with  iteration  number 
RSTART  + 1 and  continuing  through  iteration  NTRIAL)  the  following  sub- 
routines are  executed  in  order: 


ERRMC 

STG 

CAMS 

YES 

CAS 


sets  random  number  seeds 
Segment  Truth  Generator 
CAJViS  Simulator 
Yield -Estimation  Model 
CAS  Simulator 


(Prior.to  each  of  the  calls  to  STG,  CAMS,  YES,  and  CAS,  LEM  calls  sub- 
routine SETPRF  to  properly  set  the  print  flag  PRINTF. ) 


Finally  after  the  last  Monte'Carlo  iteration  has  been  completed  sub- 
routine WRAPUP  is  called  to  print  the  program  status  information  and  to 
close  random  access  files. 
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SUBROUTINE  ERRMC 


Purpose; 

Subroutine  ERRMC  provides  the  Error  Model  control  for  the  LEM 
program  by  properly  initializing  the  random  number  seeds  for  the  follow- 
ing error  sources; 


Classification  error 
Signature  extension  error 
Segment  Crop  Calendar  error 

CAS  Group  II  error  "Most  Recent  Non-Epoch  Year"  Historical 
Proportion  of  "Wheat 

CAS  Group  III  Multi-year  Proportion  of  Wheat 


Input; 


Common 


Quantity 

Bio  ck 

Source 

ICAMS  . 

LEMCM. 

INPUT 

ICLASS  ■ 

LEMCM 

INPUT 

ISEXT 

LEMCM 

INPUT 

ISCC 

LEMCM 

INF  UT 

ICAS 

LEMCM 

INPUT 

ICAS2 

LEMCM 

INPUT 

ICAS  3 

LEMCM 

INPUT 

RSEED 

LEMCM 

INPUT 

Output: 


Quantity 

SEED 


Common 

Block 

CNTRL 


Used  By 

STG,  CAMS,  YES, 
CAS,  WRAPUP 
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Linkage: 

CALL  TERRMC 

t 

There  are  no  arguments.  All  input /output  quantities  are  transmitced 
through  COMMON  storage. 

Subroutine  Used: 

None. 

Local  Variables: 

None. 


Processing; 

See  flow  chart. 


ERRMC 
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SUBROUTINE  ERRMES 


Purpose: 

Subroutine  ERRMES  prints  an  error  message  as  directed  by  the  input 
parameters. 


Input: 

PROG,  SUBR,  ICODE,  and  LEVEL  are  input  parameters  trans- 
mitted through  the  calling  sequence.  In  addition,  the  following  quantities 
are  passed  through  COMMON  storage: 

Common 


Output: 


Quantity 

Bio  ck 

NERRS 

ARGLST 

N FATAL 

ARGLST 

NPERRS 

ARGLST 

NARG 

ARGLST 

ARG  • 

ARGLST 

• 

Common 

Quantity 

Block 

NERRS 

ARGLST 

NFATAL 

ARGLST 

NPERRS 

ARGLST 

In  addition  to  the  error  counters  being  advanced,  an  error  message 
is  written  onto  the  printed  repont.  Parameters  obtained  from  the  array 
ARG  may  be  included  in  the  error  message. 


Linkage: 

CALL  ERRMES{PROG,  SUBR, ICODE,  LEVEL) 

where 

PROG  is  the  subprogram  name  in  A6  format  (e.  g.  , 4H  CAMS, 

3H  YES,  etc, ) 
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is  the  name  of  the  subroutine  within  the  subprogram 
also  in  A6  format  (e.  g. , INPCHK) 

is  the  error  code.  (See  processing  for  a list  of  codes 
and  associated  messages,  ) 

is  the  level  of  the  error, 

= 0 for  non  fatal 

= 1 for  fatal 

= 2 for  step  fatal  - skip  this  step,  e.g.  , CAMS,  but 
continue  with  the  run. 

In  addition,  a list  of  arguments  (to  be  printed  out  as  part  of  the  error 
message)  is  stored  in  the  array  ARG  within  the  COMMON  block  ARGLST 
and  the  argument  count  is  stored  in  NARG, 

Subroutines  Used: 


Local  Variables: 

IMES 
BLANK 
NONFTL 
ERRLVL 

Processing: 

For  non-fatal  errors  the  following  general  message  is  printed  out 
on  the  report  followed  by  a specific  error  message; 

nonfat AL  ERROR  IN  SUBPROGRAM SUBROUTINE 

ERROR  CODE 


PAGER 
INPERR 
GAMERS 
CASERl 

Error  code 
Word  of  blanks  (format  IH  ) 
part  of  error  message  (3  H NON) 

Blank  or  = NONFTL  (used  to  fill  part  of  error  message) 


CAMER2 
CASER2 
STGERR 
WRAP  UP 


SUBR 
ICODE  • 
LEVEL 


^ 'T'  'T- 
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For  step  fatal  errors  the  following  general  message  is  printed  out 
on  the  report  followed  by  a specific  error  message: 

fatal  ERROR  n IN  SUBPROGRAM SUBROUTINE 

ERROR  CODE 
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Subroutine  RANACF 


Purpose: 

RANACF  is  a,  standardized  random  access  l/O  s xbroutine.  Written 
in- Fortran,  it  provides  a central  location  for  all  operations  on  random.' 
access  files  (opening,  closing,  reading,  and  writing).  RANACF  contains 
calls  to  the  installation -dependent  random  access  routines. 

Input: 

IFILE,  IREC,  N,  L,  lOPT  (See  Linkage) 

In  addition,  if  lOPT  = 2,  then  BUF  is  input  to  RANACF. 

Output: 

If  lOPT  = 1,  then  BUF  is  output  by  RANACF. 

Linkage : 

CALL  RANACF  (IFILE,  IREC,  BUF,  N,  IX,  L,  lOPT) 


where 

IFILE 

Logical  unit  number  of  the  random  access  file. 

IREC 

= 

Record  number  to  read  or  write. 

BUF 

= 

Array  of  N words  to  be  read  from  or  written  onto 
the  random  access  file. 

N 

= 

Number  of  words  to  read  or  write. 

IX 

= 

Index  array  (length  L).  (Required  on  CDC  computer 
but  not  on  UNIVAC.) 

L 

= 

Length  of  index. 

lOPT 

Entry  point  option: 

-0 

to  open  the  file 

= 1 

to  read  a record 

=2 

to  write  a record 

= -l 

to  close  the  file 

Subroutines  Used: 

OPENMS 

REALMS 

WRITMS 

CLOSEMS 


I 


Used  on  CDC  computer.  Similar  routines  are 
required  on  UNIVAC. 
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Local  Variables: 

None. 

Processing;; 

The  appropriate  roatine  is  called  to  open,  close  read,  or  write 
the  file  as  specified  by  lOPT. 
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SUBROUTINE  SETPRF 


Purpose: 

Subroutine  SETPRF  sets  the  print  flag  PRINTF  to  print  reports  or 
suppress  printing  for  a given  module  depending  upon  the  iteration  number 


and  the  input  print  flag  for 

that  module. 

Input: 

Quantity 

Common 

Block 

Source 

> 

IPR 

(see  Linkage) 

LEM 

RSTART 

LEMCM 

INPUT 

NTRIAL 

LEMCM 

INPUT 

ITER 

STATS 

LEki 

Output: 

Quantity 

Common 

Block 

PRINTF 

CNTRL  ^ 

' = 0 to  suppress  printing 
[ = 1 to  print  this  iteration 

Linkage: 

CALL  SETPRF  (IPR) 

where 

IPR  is  the  input  print  flag  (e,  g. , IPRINT,  IPRCAM,  etc.) 

= 0 to  print  first  and  last  iterations  of  each  run 

= 1 to  print  every  iteration 

= 2 to  print  only  the  last  iteration 

= 3 to  suppress  all  printing  of  reports 
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Subroutines  Used; 
None. 

Local  Variables: 
None. 

Processing: 


See  flow  chart, 
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None 


Local  Variables; 
None 


Procesiiing: 
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SUBROUTINE  INPCHK 


Purpose; 

Subroutine  INPCHK  checks  the  validity  of  the  LEM  Control  Card 
parameters.  It  also  reads  the  header  records  of  each  required  input  file 
and  checks  the  file  name,  case  number  and  country  on  that  file. 


Input; 


All  of  the  quantities  in  the  COMMON  blocks  LEMCM  and  FILES 
are  inputs  to  INPCHK. 


In  addition,  the  following  quantities  are  input  to  INPCHK: 


Quantity 


Common 

Block  Source 


NTRMX 

MAXR 

MAXZ 


CONST 

CONST 

CONST 


Block  Data 
Block  Data 
Block  Data 


Also,  the  following  files  may  be  input  to  INPCHK  so  the  header 
information  may  be  checked; 


Segment  ID  file 
Crop  Window  file 
Substrata  Historical  file 
CAMS  Error  Model  file 
YES  Error  Model  file 
Signature  Extension  file 
Data  Acquisition  file 
Segment  Truth  file 
CAMS  Output  file 
YES  Output  file 
CAS  Cumulative  Output  file 
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Output; 

Quantity 
NERRS 
NFATAE 

Linkage: 

CALL  INPCHK 

There  are  no  parameters  in  the  calling  sequence. 

Subroutines  Used; 

ERRMES 
RAN AGE 

Local  Variables: 

FILL  Filler  for  header  records  of  input  files 

NFILL  Number  of  words  of  filler  necessary  to  complete  record 

Processing; 

Check  Input  Data 

(Control  Card  parameters  and  File  Headers) 

1.  . NTRIAL  - RSTART  ^ NTRMX?- 

2.  RSTART  < NTRIAL? 

3.  0 ^ STARTR  ^ ENDR  ^ MAXR? 

4.  0 £ STARTZ  £ ENDZ  ^ MAXZ  ? 

ISTG,  ICAMS,  lYES,  must  be  0,1,2,  or  3. 

If  CAMS  ^ 0,  then  ISTG  i 0? 


Common 
Bio  ck 

ARGLST 

ARGLST 


Used  By 
LEM,  WRAP  UP 
WRAP UP 


5. 

6. 
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7.  If  ISTG  - 0 or  if  ISTG  - 1 or  3 and  RSTART  = 0,  then  read  and 
check  Segment  ID  file  header 

a)  filename  = "SEGMENT" 

b)  case  number  = ICSESG 
■c)  country  = GENTRY 

8.  If  ICAMS  = 0 or  if  ICAMS  = 1 or  3 and  RSTART  = 0,  then  read  and 
check  Crop  Window  file  header, 

a)  filename  = "CROPWIND" 

b)  case  number  = ICSECW 

c)  country  = CUNTRY 

9.  If  ICAMS  = 0 or  if  ICAMS  = 1 or  3 and  RSTART  = 0,  then  read  and 
check  CAMS  Error  Model  file  header. 

a)  filename  = "CAMSERR" 

b)  case  number  = ICSECE 

c)  country  = CUNTRY 

10.  If  ICAMS  = 0 or  if  ICAMS  = 1 or  3 and  RSTART  = 0,  then  read  and 
check  Signature  Extension  file  header. 

a)  fUeiiame  = "SIGEXTEN" 

b)  case  number  = ICSESE 

c)  country  = CUNTRY 

11.  If  ICAMS  = 0 or  if  ICAMS  = 1 or  3 and  RSTART  = 0,  then  read  and 
check  Data  Acquisition  file  header. 

■ a)  filename  = "AGQUISI" 

b)  case  number  = ICSEAC 

c)  country  = CUNTRY 

12.  If  lYES  = 0 or  if  lYES  = 1 or  3 and  RSTART  = 0,  then  read  and 
check  YES  Error  Model  file  header, 

a)  f Rename  = "YESERROR" 

b)  case  number  = ICSEYM 

c)  country  = CUNTRY 
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13.  Read  and  check  header  ol  Substrata  Historical  file. 

a)  filename  = "SUBHIST" 

b)  case  number  •=  ICSESH 

c)  country  = CUJSFTRY 

14. '  If  ISTG  =-2  or  if  ISTG  = 1 or  3 and  RSTART  > 0,  then  read  and 

check  header  of  Segment  Truth  file. 

a)  filename  = "SEGTRUTH" 

b)  case  number  = ICSEST 

c)  country  = CUNTRY 

15.  If  ICAMS  = 2 or  if  ICAMS  = 1 or  3 and  RSTART  > 0,  then  read  and 
check  header  of  CAMS  Output  file. 

a)  filename  = "CAMSOUT" 

b)  case  number  = ICSECO 

c)  country  = CUNTRY 

16.  If  lYES  = 2 or  if  lYES  = 1 or  3 and  RSTART  > 0,  then  read  and 
check  header  of  YES  Output  file. 

a)  filename  = "YES" 

b)  case  number  = ICSEYS 

c)  country  = CUNTRY 

17.  Open  CAS  Cumulative  Output  file  (a  random  access  file). 

18.  If  RSTART  > 0,  then  lead  and  check  header  of  CAS  Cumulative  Output 
file. 

a)  filename  = "CAS  CUM" 

b)  case  number  = ICASE 

c)  country  = CUNTRY 

d)  NT  = RSTART 


Rewind  each  file  before  and  after  reading  its  header  record. 
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SUBROUTINE  INPUT 


Purpose: 

LEM  reads  the  LEM  control  cards  and  calls  INPCHK  to  check  the 
LEM  control  card  data.  INPUT  also  calls  CAMSIN  and  CASIN  to  read  the 
remaining  control  card  input  data. 


Input: 


All  of  the  quantities  in  Common  block  LEMCM  are  input  to  INPUT 
from  the  input  file. 


In  addition  the  following  quantities  are  inputs  to  INPUT. 


Quantity 

INP 
OUTP 
NERRS 
N FATAL 


Common 

Block 

FILES 
FILES 
AUGLST 
■ ARGLST 


Source 

Block  Data 
Block  Data 
ERRMES 
ERRMES 


Output: 

All  of  the  quantities  in  common  block  LEMCM. 

In  addition,  the  following  quantities  are  output  from  INPUT. 

Common 

Quantity  Block  Destination 

ARG(l)  ARGLST  ERRMES 

NPAGE  PAGECM  EJECT 

Linkage: 

CALL  INPUT 

There  are  no  parameters  in  the  calling  sequence. 
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Subroutines  Used; 

ERE.MES 
EJECT  • 

INPCHK 
CAMSIN 
CASIN 
• PAGER 

Local. Yariables; 

LBL  Label  on  LEM  control  cards 

LBLl  Label  on  first  LEM  control  card 

Processing: 

1.  The  first  two  LEM  control  cards  are  read  in. 

2.  The  labels  on  the  first  two  LEM  control  cards  are  checked.  They 
must  be  LEM  01  and  LEM  02. 

3.  Next  subroutine  EJECT  is  called  to  eject  a page  on  the  output  file 
and  to  write  the  case  header  at  the  top  of  the  page. 

4.  The  data  from  the  first  two  LEM  control  cards  is  printed  out. 

5.  Next  the  third  and  fourth  LEM  control  cards  are  read,  their  labels 
are  checked  and  the  data  is  printed  out. 

6.  Next  subroutine  INPCHK  is  called  to  check  the  LEM  control  card 
data  for  errors. 

7.  Then  routines  CAMSIN  and  CASIN  are  called  to  read  and  check  the 
CAMS  control  card  data  and  the  CAS  control  card  data. 

8.  Finally  the  number  of  non  fatal  and  fatal  errors  detected  in  the 
LEM,  CAMS,  and  CAS  control  cards  is  printed  out. 


REPRODUCIBILITr  OF  THE 
ORIGINAL  PAGE  IS  POOR 
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SUBROUTINE  STG 


Purpose; 

The  purpose  of  Lhe  Segment  Truth.  Generator  (STG)  is  to  g'enerate 
the  true  proportion  wheat  and  the  true  proportion  mixed  pixels  for  eacii 
sample  segment,  STG  interfaces  with  the  Segment  ID'  file  and  the  Sub- 
strata Historical  file  to  obtain  the  data  necessary  to  produce  the  Segment 
Truth  me. 

Input; 


The  following  quantities  are  obtained  from  the  Segment  ID  file; 

COUN 

Country  ID 

IREG 

Region  ID 

IZONE 

Zone  ID 

ISTRAT 

Strata  ID 

ISUBS 

Substrata  ID 

ISEG 

Segment  ID 

ITRAIN 

Training  Segment  Indicator 

ITSPRL 

Training  Segment  Priority  List 

SEAT 

Segment  latitude  (not  used) 

S-LONG 

Segment  longitude  (not  used) 

GRIDNO 

Grid  Number  (not  used) 

ISW 

■ Sprin/Winter  wheat  indicator 

The  following  quantities  are  obtained  from  the  Substrata  Historical 

COUN2 

Country  ID 

IREG2 

Region  ID 

IZONE2 

Zone  ID 

ISTRA2 

Strata  ID 

ISUB2 

Substrata  ID  ■ 

NSEG 

Number  of  sample  segments  in  this  substratum 

IDSEG 

List  of  sample  segments  in  this  substrata  (dimensioned 

IMXSEG] 


GRPNO 

HISTPW 

AREA 

PWK 

NAGR 

NA 

DELTPW 

DELTPM 

CVi 

CV2 

CV3 

CV4 

Tlie  following 

Quant  iby 

PRINT  F 
SEED(l) 

END  FIE 

IMXSEG 

ITSFLG 

SEGID 

LSEGID 

SUBHST 

LSUBH 

SEGTRU 

LSEGTR 

ICASE 

GENTRY 

N TRIAL 

RSTART 
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Group  number  (not  used) 

Historical  PW  (not  used) 

Substrata  land  area  (not  used) 

True  proportion  of  wheat 

Number  of  agricultural  segments  in  the  substrata 
(not  used-)- 

Number  of  allocated  segments  in  the  substrata  (not 
used) 

gPW  = bias-  of  true  proportion  of  wheat  (not  used) 

5PM  = ratio  of  true  mixed  pixels 

Coefficient  of  variation  for  year-to-year  change  in 
PW  (not  used) 

Coefficient  of  variation  for  within  county  variation 
of  PW 

Coefficient  of  variation  for  within  county  variation  of 
proportion  of  mixed  pixels 

Coefficient  of  variation  of  multi-year  historical 
wheat  area  (not  used) 

input  quantities  are  obtained  from  labeled  COMMON: 
Common 


Bio  ck 

Source 

CNTRL 

SETPRF 

CNTRL 

ERRMC 

CONST 

Block  Data 

CONST 

Block  Data 

CONST 

INPCHK 

FILES 

INPCHK 

FILES 

INPCHK 

FILES 

Block  Data 

FILES 

Block  Data 

FILES 

Block  Data 

FILES 

Block  Data 

LEMCM 

INPUT 

LEMCM 

INPUT 

LEMCM- 

INPUT 

LEMCM 

INPUT 
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Quantity 

Common 
Bio  ck 

Source 

IPRINT 

LEMCM 

INPUT 

STARTR 

LEMCM 

INPUT 

STARTZ 

LEMCM 

INPUT 

ENDR 

LEMCM 

INPUT 

ENDZ 

LEMCM 

INPUT 

ISTG 

LEMCM 

INPUT 

ICASEl 

LEMCM 

INPUT 

TCASE2 

' LEMCM 

INPUT 

ICASE  3 

LEMCM 

INPUT 

NLINE 

PAGECM 

PAGER 

MXLINE 

> 

Block  Data 

ITER 

STATS 

LEM 

Output; 

The  following  quantities  axe  written  onto  the  Segment  Truth  file: 

Variable 

ICASE 

ITSFLG 
C UNTRY 
IREG 
IZONE 
ISTRAT 
ISUBS 
ISEG 
ITRAIN 
ITSPRL 
ISW 
PWKI 


PMj^i  = True  proportion  mixed  pixels 
for  this  segment 


Training  Segment  flag 
Country  ID 
Region  ID 
Zone  ID 
Strata  ID 
Substrata  ID 
Segment  ID 

Trciining  Segment  Indicator 
Training  Segment  Priority  List 
Spring /Winter  indicator 
PW,  . = True  proportion  wheat  for  this 

-Kl  , 


PMKI 


28234- 6029  •'R.U- 00 
Page  260 


In  addition. 


the  following  quantities  are  printed  on  the  Segment  Truth 


report: 


PWK  Substrata  true  PW 

PWKI 

PMKI 

AVEPW  Average  PW  for  current  substrata 

ERRPW  Error  in  segment  PW  (segment  True  PW  - Substrata 

True  PW) 


The  following  output  quantities  are  stored  in  COMMON: 


Variable 

NREC(l) 

NSEGTR 


Common 
Bio  ck 

STATS 

STATS 


Used  By 

WRAP  UP 
WRAJ>UP 


Linkag  e : 

CALL  STG 

There  axe  no  arguments  in  the  calling  sequence.  All  input /output 
quantities  are  transmitted  through  COMMON  storage. 


Subroutines  Used; 

BET  AD  Beta  distribution  routine 

CALL  BETAD  (SEED,  AVE,  SIGMA,  RI',  lOPT,  lERROR) 


ERRMES  CALL  ERRMES  (PROG,  SUBR,  ICODE,  LEVEL) 

EJECT 


PAGER 


Page  Eject  routine 
Automatic  Paging  routine 
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Pro  cessing; 

A detail  flow  chart  for  the  Segment  Truth  Generator  is  given  on  the 
following  pages c 

The  true  PW  and  true  PM  for  each  segment  are  computed  a.s  follows: 

a)  If  ISTG  = 3 (zero  error  case) 

PWKI  - PWK 

PMKI  = PWK  * DEL.TPM 

(i,  e,,  segment  truth  values  = substrata  truth  values) 

b)  . If  ISTG  = 0 or  1 

PWKI  is  computed  b-y  the  BETAD  subroutine  with 
mean  = PWK/ 100.0 
SIGMA  = PWK  >1=  CV2/100.  0 

PMKI  is  computed  by  the  BETAD  subroutine  with 
mean  = (PWKI  * DELTPM)/i00.  0 


SIGMA  = mean  CVS 
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Write 
record  on 
Segment 
Truth  File 


Advance 

SEGID, 

SEGTRU 

counters 


Sum  PVf 
for  this 
substrata 


Save  PW,  PM 
for  Segment 
Truth  Report 
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CAMS  SUBROUTINE  DESCRIPTION 
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SUBROUTINE  CAMSIN 
Purpose: 

This  subroutine  reads  in  the  CAMS  control  cards,  echos  the  data 
on  the  printer,  and  stores  it  in  the  COMMON  block  /CAMSCMy^  The 
data  consists  of  13  cards,  one  CAMS  control  card,  eight  multi-temporal 
sampling  matrix  cards,  and  four  crop  calendar  coefficient  cards.  CAMSIN 
checks  for  errors  in  the  data  and,  if  found,  prints  appropriate  messages 
and  aborts. 

Input: 


The  main  inputs  are  the  13  input  data  cards.  See  the  CAMS  Problem 
Description,  Figures  1-4,  for  the  format  and  contents. 


Also  needed  are  the  COMMON  block  quantities: 

/FILES/ 

INP 

input  device  number 

OUTP 

output  device  number 

/PAGECM/ 

used  by  PAGER  and  EJECT  subroutines 

/LEMCM/ 

TITLE 

used  by  PAGER  and  EJECT  subroutines 

Output: 

The  main  output  is  the  COMMON  block  /CAMSCM/. 

/CAMSCM/  IMODEL, 

IMULTI 
ISIGEX 
ISKIP 
ITMAX 
IREP 
IWIND 

IGROUP(3,  2,  15)  multi- temporal  sampling  matrix  data; 

see  Figure  2,  CAMS  Problem  Description 
’ - dimension  1 = type  (wheat,  mixed,  other) 

2 = season  (winter,  spring) 

3 = for  IGROUP,  which  M 

(1,  2,  or  3) 


CAMS  control  card  inputs;  see 
Figure  1,  CAMS  Problem  Description 
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MS(3,  2,  3)  for  MS,  values  of  M (M(2)'  and  M(3) 

from  input,  M(l)  = 1) 
if  model  1,  ignore  model  2 data 
if  model  2,  ignore  model  1 data 'and 
store  in  type  = wheat  (type  = mixed, 
other  values  sei,  to  0) 

crop  calendar  coefficients  data;  see 
Figure  3,  CAMS  Problem  Description 
- dimension  1 = type 

2 = season 

3 = for  G,  which  G 
(G1  or  G2) 
for  H,  which  H 
(HI  or  H2) 

if  model  1,  ignore  model  2 data 
if  model  2,  ignore  model  1 data  and 
store  in  type  = wheat  only  (mixed  and 
other  set  to  0) 

Also  output  to  the  printer  is  an  echo  of  the  input  data,  with  the  same 
quantities  as  are  on  the  input  data  cards.  Blank  default  columns  will  con- 
tain 0. 0 values. 

Also,  possible  output  are  the  input  error  messages.  See  CAMS 
Problem  Description,  Section  5.  2. 

Linkage: 

- CALL  CAMSIN 
Subroutines  Used; 

CALL  EJECT (IND)  to  help  printing  echo  of  data  - supplied  utility 
• CALL  PAGER(IND)  routines 

ABS(X)  absolute  value 

Local  Variables: 


G(3,2,2) 
H(3,  2,  2) 


ICHK(4,  2,  15)  holds  IGROUP  array  for  error  checking 

dimension  i = type,  model  1 wheat  = 1 

model  1 mixed  = 2 
model  1 other  = 3 
model  2 = 4 

dimension  3 - which  M tc  use,  1-4  - 1 

5-15  = input  data 

C?IKM(4,  2,  3)  holds  MS  array  for  checking,  M(l)  = 1 

ISEQ(4,  2)  holds  sequence  numbers  for  matrix 

CHKG(4,  2,  2)  holds  G and  H arrays  for  error  checking 

CHKH(4,  2,  2) 
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SUBROUTINE  CAMSIN  BLOCK  DIAGRAM 


CAMS IN 


READ  CONTROL  CARD 
READ  (INP) 


■^BAD  ID^ 
OR 

^SEQ  NO.> 


CALL  ELRMES 
BAD  CA..S  ID 
OR  SEQ  NO. 


^ BAD  ^ 
MODEL  FLAG 

V ? 


CALL  ERRMES- 
MODEL  NOT  I OR  2 


BAD  IMULTI 
FLAG  . 


BAD  ^ 
ISIGEX 
FLAG 


BAD  I SKIP 
FLAG 


BAD  I REP 
FLAG 


CALL  ERRMES- 
VALUE  NOT  0 OR  1 


CALL  ERRMES- 

ITMAX  NOT  BETWEEN  0 AND  99 


CALL  ERRMES- 

I WIND  NOT  BETWEEN  0 AND  4 


ECHO  OF 
CONTROL  CARD 
WRITE  (OUTP) 


IWIND  = 0 

? V 


YES 


I 


CAMS IN  (CONT'D) 
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CAMSIN  (CONI' D) 
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CAMSIN  (CONT'D) 
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SUBROUTINE  BE  TAD 

Purpose:  To  compute  a random  number  based  on  the  Beta  distribution 
or  normal  distribution,  given  a random  number  seed. 

Input:  No  input  from  COMMON  or  files. 

Output:  No  output  to  COMMON  or  files. 

Linkage;  CALL  BETAD  (SEED,  XBAR,  SIGklA,  XI,  lOPT,  lER) 

Input:  SEED  A double  precision  random  number  seed  used  to 

get  a uniform  random  number  P,  0 <P  <1 

XBAR  Mean  value  X,  0 ^ X ^ 1 

SIGMA  Standard  deviation  cr,  0 ^ O' 

I OPT  = 0 use  Beta  distribution 

4 0 use  normal  distribution 

Output:  XI  Random  number  based  on  Beta  or  normal  distribution 

X. 

1 

lER  Error  flag 

= 0 no  errors  

= 1 XBAR  not  in  range,  0 ^ X ^ 1 so  was  reset 
within  subroutine 

= 2 SIGMA  not  in  range,  0 ^ o ^ X 

X+  e 
' -4 

was  reset  within  subroutine, € = 10 

= 3 Fatal  error,  XI  could  not  be  found  within  con- 
straints of  subroutine;  e.  g. , within  35  iterations 
via  the  inverse  incomplete  beta  function  method 

SEED  To  be  used  fo_r  next  call  to  BETAD  (a  double  precision 
number) 

Subroutines  used; 

CALL  RDMIA  (SEED,  P)  to  get  uniform  random  number  P 

SEED  = double  precision 

CALL  IBETAt  (X,  A,  B,  P,  lER)  to  get  incomplete  beta  function 

Note;  IBETAI  is  algorithm  AS  63  Appl.  Statist.  (1973).,  Voi.  22,  No.  3 
SQRT  (X)  squareroot  • 

‘A LOG  (X)  exponential 

EXP  (X)  natural  logarithm  • 

ALOG(X)  natural  logarithm 


Local  variables 
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A 

First  Beta  parameter 

B 

Second  Beta  parameter 

BP 

Recalculated  second  Beta,  parameter 

CHK 

Normal  distribution  parameter 

DIFF 

Accuracy  check 

DIFFl 

Check  if  XI  close  to  0 

EP 

-4 

10  , accuracy  of  answer 

FLAG 

INTEGER 

Flag  to  signal  XBAR  > . 5 

H 

Beta  approx,  parameter 

I 

Loop  counter 

K 

REAL 

2.  , method  threshold  constant 

P 

Output  from  RDMIA,  f(X)  for  Beta  function 

PHI 

Limit  for  iteration  of  P 

PLO 

Limit  for  iteration  of  P 

PO 

■ 

Output  from  IBETAI 

R 

88.  , Gamma  constraint 

RN 

Normal  distribution  parameter 

SIG 

Stores  SIGMA,  or  SIGMA L,  for  use  in  routine 

SG 

10  check  on  successive  answers  in  loop 

SIGMAL 

Upper  limit  on  SIGMA 

SIGSQ 

SIG  SIG,  intermediate  calculation 

SIGT 

Method  threshold  sigma,- 

T 

Normal  distribution  parameter 

w‘ 

Beta  approx,  parameter 

XAVG 

XBAR,  or  1 - XBAR  if  XBAR  > ,5 

XHI 

Limit  for  iteration  of  X 

XLO 

Limit  for  iteration  df  X 

XSQ 

XBAR  'I'  XBAR,  intex*mediate  calculation 

■ Y 

Beta  approx,  parameter 

YP 

Beta  approx,  parameter 
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BETAD  Subroutine  Equations 

Equation  set  1 - normal  distribution  parameters: 


In 


T=  ^ 


In 


1 


0 < P s .5 


. 5 < P<1 


CHK  = T - 


(I'-P) 

2.  30753  + . 27061T 


RN  = 


■ 1.  + . 99229T  + .04481T 
- CHK  0 <PS.  5 


+ CHK 


5 < P<  1 


Equation  set  2 ~ SIGMA  upper  limit; 

i 


SIGMAL  = XBAR  <^\  EP  = lO"'^ 


XBAR  + EP 


Equation  set  3 - Beta  function  parameters; 

A = XBAR^  - XBAR  (XBAR^  + SIGMA^) 

SIGMA  ^ 


„ 1 - XBAR  , , 

^ " V XBAR  ^ ^ 


Equation  set  4 - method  threshold: 


SIGT  = XBAR 


- XBAR 
XBAR  + K 


K = 2 


Equation. set  5 - Beta  approximation  parameters: 
YP  = -RN 


H = 2 


( 


1 


2A  - 1 ■ 2B 


br)"- 


Y = 


YP  - 3 
•6 


1/2 


. YP  (H  + Y)^^^  (_  1 f^Y-i-5  __2_^ 

-.1  2A  - 1 y V ^ 6 3H  y 


,28234-6029-RU-00 
.Page  27-8 


Equation  set  6 - XI  for  Beta  approximation: 


XI  = 


^ 

A + B • 


2W 

e 


ABS  (ALOG  (B)  + 2 * W)  ^ 87 


Equation  set  7 - recompute  A and  B,  Beta  parameters: 


Equation  set  8 - 

_ (XHl  ^ XLO) 


( ENTER  ) 
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Inputs;  SEED  (double  precision) 

■ r 

XBAR 

V 

SIGMA 

lOPT 

Choose  uniform 

Outputs:  lER 

random  no.  0 <P  < 1 

XI 

CALL  RDMIA 

SEED 

(SEED.P) 

-4 

Con s ts-iit-s ! EP  ^ iO 

^ \!/ 

SG  = 10"10 

Compute  T,  CHK,  RN  - 

K = 2. 

normal  distribution 
parameters 

Eqn,  set  1 

R = 88. 

dis.tr ib,  ? 

^ YEi 

X NO 

^/'■^heck^s, 
end  cases 

0 ^ XBAR  £ 1 
0 < SIGMA 

XI  =‘KN 


r 

RETURN 

J 

V 

J 

Xl=l 

XBAR>1 

XI=0 

XBAR<0 

XI=XBAR 

XBAR=0 

XBAR=i 

lER 

= 1 

RETURN 


FLAG 


^ Switch? 
XBAR  ^ . 5 


FLAG  = 1 
XBAR  = 1-XBAR 


Compute  upper  limit  on 
SIGMA  - SIGMAL 

_4 

Eqn.  set  2,  E = 10 


BETA’D  Subroutine  Flowchart  {Sheet  1 of  3) 


Set  first  guess  XI  = XBAR, 
1 = 0 

Limits  XLO  = 0,  PLO  = 0, 


XHI  = 1,  PHI  = 1 


BETAD  Subroutine  Flowchart  (Sheet  3 of  3) 


Compute  method  threshold 
SIGT 

Eqn.  set  4,  K = 2,  0 


BETAD  Subroutine  Flowchart  (Sheet  2 of  3) 

, 4 
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SUBROUTINE  CAMS 
Purpose: 

This  is  the  driver  for  the  CAMS  moduleo  It  calls  the  appropriate 
subroutines  to  calculate  intermediate  error  quantities  and  then  combines 
them  for  the  estimated  proportion  of  wheat  for  each  acquisition  date  for 
each  segment.  Depending  on  error  bypass  flags,  certain  error  calcula- 
tions may  be  bypassed.  Model  2 is  treated  as  a subset  case  of  the  more 
complex  model  1,  where  the  error  factors  for  mixed  and  other  fields  are 
not  computed.  To  do  this,  data  from  the  input  files  and  cards  must  be 
read  in  and  stored  depending  on  which  model  is  used.  Figure  6 of  the 
CAMS  Problem  Description  gives  the  flow  of  this  subroutine. 

Input:- 

/CAMSCM/  IMODEL 
IMULTI 
ISIGEX 
ISKIP 
ITMAX 
IREP 
IWIND 

IGROUP  {3,  2,  15) 

MS  (3,  2,  3) 

G (3,  2,  2) 

H {3,  2,  2) 

/LEMCM/  ISEXT 

ISCC 
ICLASS 
ICAMS  • 
lACQ 
STARTZ 
ENDZ 
STARTR 
ENDR 
ICASE 

/CNTRL/  PRINTF 

SEED  (2) 

SEED  (3) 

SEED  (4) 
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Output: 

/CNTRL/  SEED(2) 

SEED(3) 

SEED(4) 

/ARGLST/  NFATAE 

/PAGECM/  NPAGE  ' 

NLINE 

/STATS/  1S!REC(2) 

NREC(4) 

NREC(6) 

NREC(7) 

NCAMSR 

CAMS  output  file  (CAMSF)  - see  file  descriptions. 

CAMS  printed  report  - see  CAMS  Problem  Description,  Figure  7. 
CAMS  error  messages  - see  CAMS  Problem"  Description,  Section  5.  3. 

Linkage : 

CALL  CAMS  - called  from  LEM  program. 

Subroutines  Used: 

CALLINPT  {ISEG,  lACQU,  ICAMER,  ICROP,  ISIGEX,  IMODEL, 
IPASS,  IDONE,  lEND)  to  read  in  input  file  records. 

CALL  INITI  (ISEG,  lACQ,  ICAMER,  ICROPW,  ISIGEX,  HEAD)  to 
initialize  input  files,  ready  to  read, 

CALL  CLASS  (SEED (2),  TYPE,  WINDOW,  M,  BCC,  SIGCC,  XI) 
to  compute  clas  sification  error. 

CALL  MULTI  (TYPE,  SEASON,  IWIN,  M)  to  compute  multi- temporal 
error. 

CALL  CROP  (SEED(4),  TYPE,  SEASON,  Y7INDOW,  IFIRST,  BCC, 
SIGCC,  ITSEG)  to  compute  crop  calendar  error. 

CALL  CORREL  (ITMAX,  ACQUIS,  WINDOW,  lUSE)  to  correlate 
training  segment  with  ordinary  segment, 

CALLSIGEXT  (SEED(3),  TYPE,  WINDOW,  lUSE,  ISIGEX,  XI)  to 
compute  signature  extension  error. 
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CALL  TSAVE  {0,-  -1,  IBAD)  to  close  RA  file  TACQ,- 
CALL  REPORT  (IPASS,  IFIRST,  IREP)  to  write  report. 
CALL  EJECT  (IND)  to  start  report. 

Local  Variable  Description: 


WHE 

MfX 

OTH 

ERR 

integer,  =1,  wheat  component 
integer,  =2,  mixed  component 
integer,  =3,  other  component 
10 “O  to  keep  from  dividing  by  zero 

IFIRST 

SEASON 

WINDOW 

TYPE 

MODEL 

flag  for  report,  =1  if  first  acquisition  for  segment  , 
^1  otherwise 

integer,  which  type  wheat,  1 = winter,  2 = spring 
integer,  which  window  acquisition  in,  1-4 
integer,  which  component  (1  = 'wheat,  2 = mixed, 

3 = other) 

integer,  how  many  iterations  to  do  (1  = model  2, 

3 = model  1) 

HEAD(4,4) 

XI(3) 

M{3) 
BCC(3) 
SIGCC(3)  ■ 
P(3) 

IWINDO(4) 

holds  window  titles  from  INITI  subroutine 
holds  total  error  from  CLASS  or  SIGEXT 
holds  multi- temporal  error  from  MULTI 
holds  crop  calendar  bias  from  CROP 
holds  crop  calendar  sigma  from  CROP 
holds  proportions,  wheat,  mixed,  other 
flags  for  MULTI,  = 0 no  acquisition  in  window 

= 1 at  least  1 acquisition  in  window 

ICROPW 

ISIG 

ISEG 

lACpNO 

flag  for  INITI  and  INPT,  CROPW  file  bypass 
flag  for  INITI  and  INPT,  SIGEXT  file  bypass 
flag  for  INPT,  SEGTRU  file  bypass 
what  acquisition  no.  on,  1-25 

IDONE 

lEND 

lUSE 

output  of  INPT 
output  of  INPT 
output  of  CORREL 

I,  J. 

IFILL 

ITOT 

indexes  for  DO  loops 
filler  for  trailer  record,  output  file 
1 no.  of  words  of  filler  IFILL 

ZEROl 

ZER02 

used  to  prevent  divides  by  0 

ZZZZ 


contains  ZZZZ  for  trailer  record 


SUBROUTINE  CAMS  BLOCK  DIAGRAM 
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SPECIAL  CASE; 


NO 

ACQUIS. 

FILE 


NO  ACQUISITION 

Tyes 

FILE 

0 

ZERO  OUT 

ERROR  VALUES 

GET  NEXT  RECORD, 

CALL  INP(0,  1,  1. 

1,  0,  0,  IDONE,  lEND) 


NO  MORE  ? 
IDONE  > 0 


■*4  CLEAN  UP  FILES 


SET  UP 
OUTPUT  FILE 
VALUES 


RETURN 


REPORT 

? 


SET  ERROR  VALUES, 

PRINT  REPORT 

NO 


CAMS  (CONI' D) 
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PASS  1 ~ TRAINING  SEGMENTS 


4 


CAMS  (CONI' D) 
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PAGS  ig 
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CAMS  (COjNT'D) 

PASS  2 - ORDINARY  SEGMENTS 


SORT  SCRATCH  FILE  INDEX 
CALL  TSAVE  [0,  3,  IBAO) 


REINITIALIZE  FILES 

CALL  INITI  (ISEG,  lACQ,  ICROPW, 

iSIG,  HEAD.  ITSFG) 


GET  next  ordinary  SEGMENT 
CALL  IHPT  (ISEG,  lACQ,  lACQ,  1, 
ISIG,  2,  IDONE,  lEND) 


NO  MORE  YES 
IDONE  > 0 > K ^ 


CALCULATE  SEASON.  INITIALIZE 
IWINDO,  CAMSF  RECORD, 

WINDOW  = 0 


WINDOW  = WINDOW  + 1 


/^ONEWITIT' 
SEGMENT'' 
WINDOW  > 4 


WRITE  RECORD  TO 
OUTPUT  FILE 
WRITE  (CAMSF) 


NO  ACQUIS. 
IN  WINDOW 


SET  IWINDO 


ZERO  ERROR  VALUES 


oeiginaIj  pagh  is 

OF  POOB  CiUAUM 


CORRELATE  WITH  TRAINING  SEGMENT 
CALL  CORREL  (ITMAX,  IWIN  (WINDOW,  I)', 
WINDOW,  IllSE) 


CAMS  {CONI' D) 
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SU  BROU  TINE  REPORT 
Purpose: 

This  subroutine  outputs  the  printed  report  for  CAMS.  On  option, 

I 

the  breakdown  of  error  values  can  be  omitted.  E.EPC  RT  Is  organized 
into  two  passes  --  training  segments  are  listed  first,  then  ordinary 
segments.  The  special  case,  no  acquisition  file,  is  handled  separately. 
For  model  2,  with  fewer  values,  zeros  appear  in  the  irrelevant  fields . 
For  the  special  case  of  an  ordinary  segment  acquisition  with  no  training 
segment  correlation,  the  data  is  flagged. 

Input:  ■ 


/ERROR/  TITLE(4) 
IDATE 
PESTIM 
TOT 

ALOCAL 

ERTOT(3) 

ERBIAS(3) 

ERRAND(3) 

CLTOT(3) 

CEBIAS(3) 

CLRAND(3) 

CROPF 

CROPD 

SIGZ{3,  2) 

MULT{3) 

TID 

TRAINA 

TRAIND 

/SEGTRU/  COUN4 

IREG4 
IZONE4 
ISTR4 
ISUB4 
ISEG4 
PT(1) 

/FILES/  CROPW 

ACQUIS 
CAMS 
CAM  ERR 
■ SIGEXT 
SEGTRU 
INP 
OUTP 
TACQ 
LCAMSF 
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Output: 

1 

Printed  report  only.  See  CAMS  Problem  Description,  Figure  7. 
Linkage: 

CALL  REPORT  (IPASS,  IFIRST,  IREP) 

e ♦ . * 

Inputs:  ' IPASS  =0  special  case  - no  acquisition  file 

= 1 training  segment  pass 
=2  ordinary  segment  pass 

IFIRST  =1  first  acquisition  for  segment 

>1  not  first  acquisition  for  segment 

IREP  report  flag  from  CAMS  control  card 

= 1 no  error  breakdown,  just  estimates 
=0  print  error  breakdown  report  too 

Subroutines  Used: 

CALL  PAGER  (IND)  to  print  headings. 

CALL  FZULU  (DATE,  lOUT)  to  get  calendar  date  from  Zulu  date. 
Local  Variable  Description: 

IOUT(3)  hold's  calendar  date  from  FZULU  subroutine 


SUBROUTINE  REPORT  BLOCK  DIAGRAM 
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REPORT  (CONT'D) 


Original  page  rq 

^■POOEQiSg® 
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SUBROUTINE  INITI 
Purpose: 

This  subroutine  initializes  the  input  and  output  files,  plus  the 
intermediate  direct  access  file,  for  CAMS.  It  finds  the  first  record 
to  proc9ss  on  the  key  file  SEGTRU,  passes  over  the  headers  of  the 
other  input  files,  opens  the  direct  access  file,  and  outputs  the  header 
on  the  output  CAMSF  file.  Depending  on  which  error  conditions  are 
bypassed,  some  steps  may  be  bypassed. 

Input: 

/LEMCM/ 


/FILES/ 


/CAMSCM/ 

See  also  linkage. 

Output: 

/INDX/  INDEX  index  for  RA  scratch  file  TACQ 

/ARGLST/'  NERRS  error  count  passed  back  from  ERRMES 

subroutine 

NFATAL 

NPERRS 

See  also  linkage. 


STARTR  starting  region  and  zone,  integers 
STA.RTZ 
lACQ 
ISCC 
ICLASS 
ISEXT 
ICAMS 

✓ 

ICASE  case  no,  of  output  file 


y for  output  file  header 


SEGTRU 
ACQUIS 
TACO 

CAMERR^  logical  file  unit  nos.  , integers 

CROPW 
SIGEXT 
CAMSF 

LCAMSF  length  of  output  record 


IMODEL  model  no,  (1  or  2) 

IMULTI  for  output  file  header 
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Linkage: 

CALL  INI TI  (ISEG,  lACQU,  ICAMER,  ICROPW,  ISGEX,  HEAD,  ITSFG) 


flags  for  input  files  - 0 read  file 

, >0  skip  reading  file 


headings  for  the  four  crop  winciows  from. 
ACQUIS  file  unless  bypassed,  then  defaults  to 

**sk*'WINDOW  3**** 

M<5J«*^WIND0W 

flag  if  all  training  segments 
=0  all  training 
40  training  and  ordinary 

Subroutines  Used: 

CALL  ERRMES  (4HCAMS,  4HINIT,  1,  1)  to  report  error  message. 
CALL  TSAVE  (0,  0,  IBAD)  to  open  scratch  file  TACQ, 

Local  Variable  Description: 


Inputs:  . ISEG 
lACQU 
ICAMER 
ICROPW 
ISGEX 

Outputs:  HEAD(4, 4) 


ITSFG 


NAME(2) 

name  of  output  file 

ICAS(5) 

case  nos.  of  input  files 

IFILL 

filler,  = 0 

/ARGLST/ 

NARG  no.  of  arguments  in  error  routine  list 

/SEGTRU/ 

COUN4  from  SEGTRU  input  file  record 

IREG4 

IZON4 

ISKP 

to  skip  over  words  1, 

ITOT 

no.  of  filler  words  on  header  output  file  record 
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SUBROUTINE  INITI  BLOCK  DIAGRAM 


INITI 


SKIP  SEGTRUr 
sj  SEG  > 0 ^ 


READ  HEADER,  SAVE  CASE  NO. 
READ  (SEGTRU) 


FIND  FIRST  RECORD  TO  PROCESS 


READ  RECORD  OF  SEGTRU 
READ  (SEGTRW)  'C0UN4, 
IREG4,  IZ0N4 


EOF? 

CONN  = ZZZZ 


CALL  ERRMES- 
BEGINNING  REGION 
AND  ZONE  NOT  FOUND 


'^START  RECORD 

IREG4  = STARTR 
AND 

JZONE4  = STARTZ. 


RETURN 


YES 


INITI  (CONT'D) 
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SUBROU  TINE  MULTI 
. Purpose: 

This  subroutine  returns  the  multi- temporal  sampling  error  factor 
from  the  card  input  matrix^  depending  on  the  kind  of  wheat  (winter,  spring), 
the  type  (wheat,  mixed,  other),  and  which  windows  have  had  acquisitions. 
Model  2 is  treated  as  though  kind  of  wheat  is  wheat  only.  A value  for  the 
error  report  is  saved. 

Input: 

/CAMSCM/  IGROUP(3,  2,  15)  from  card  input 
MS(3,  2,  3) 

See  also  linkage. 

. Output: 

/error/  MULT(3)  for  error  report 

See  also  linkage. 

Linkage: 

CALL  MULTI  (TYPE,  SEASON,  IWIN,  M) 

Inputs: 

TYPE  integer,  which  component  of  mixed  crops  (1  = wheat, 

2 = mixed,  3 = other:  for  model  2,  1 = wheat  only  used) 
SEASON  integer,  which  kind  of  wheat  (1  = winter,  2 = spring) 

IWIN(4)  integer  flag  for  each  window,  if  had  acquisition  = 1, 

if  not  = 0 

Outputs: 

M multi -temporal  error  factor 

Subroutines  Used: 


None. 
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Liocai  Variable  Description: 


IFIND  calculates  wliich  grouping  to  use,  given  which  windows 

have  acquisitions.  It  works  as  though  INDEX{IFIND) 
really  were  INDEX  (IWIN(  1)  + 1,  IWIN(2)  + 1,  1WIN(3)  + 1, 
IW’IN{4)  + 1),  a 4-dimensional  array,  where,  for  example: 
•INDEX{2,  1,  1,  1)  gives  which  group  to  use  ii  only  acqui- 
sitipns  for  first  window;  INDEX(jl,  2,  L,,-L)  '.group  if.  only 
acquisitions  for  second  window. 


INDEX(16) 
IS  TATE 
IWHATM 


index  to  which  group  to  use 
which  group  to  use,  equation  B4-6b 
which  M to  use,  equation  B4-6c 
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SUBROUTINE  MULTI  BLOCK  DIAGRAM 


ALL  EQUATIONS 
FROM  CAMS  PROBLEM 
DESCRIPTim,  . 
SECTION  3.3, B 
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SUBROUTINE  SGEXT 
Purpose : 

This  subroutine  calculates  the  signature  extension  error.  It  uses 
the  bias  and  sigma  from  the  SIGEXT  input  file  to  generate  a .random 
number  from  a;beta  distribution.  Quantities  for  the  error  report  are 
also  computed  and  saved  if  needed. 

Input: 


/CAMERR/  PW(3,4)  probabilities 


/TRAINS/  TM(TYPE)  error  quantities  of  training  segment 

TB(TYPE) 

TV(TYPE) 

TERTOT(TYPE) 


/SIGEXT/  ZB(3,  2) 

^ ZSIG(3,  2,  6) 


bias  and  sigma  for  signature  extension 
errpr 


/CNTRL/  PRINTF 


print  flag,  integer 


/CAMSCM/  IREP 
ISIGEX 


print  flag  for  error  report 


See  also'  linkage. 

Output: 

/ERROR/  ERTOT(TYPE)  error  report  quantities 
SI  GZ  (TYPE,  1) 

SI GZ  (TYPE,  2) 

X(TYPE,  1) 

X(TYPE,  2) 

See  also  linkage. 

Linkage: 

CALL  SIGEXT  (SEED(3),  TYPE,  WINDOW,  lUSE,  XI) 


Input  s : 

SEED(3) 

TYPE 

WINDOW 

lUSE 


double  precision  random  no.  from  beta  distribution 
for  signature  extension  error 

integer,  which  component  of  mixed  crops  (1  = wheat, 

2 = mixed,  3 = other;  model  2 uses  1 = wheat  only) 
integer,  v/hich'kind  of  wheat  (1  = winter,  2 = spring) 
from  CORREL  subroutine,  which  training  segment  using 
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Outputs : 

XI  total  error  factor 

SEED(3)  double  precision  random  no.  seed  after  use 
Subroutines  Used; 

’ * ' . * . * 

CALL  BETAD  (,SEED(3),  XBAR,  SIGMA.^  XI,  0,  lER)'  to  get  random 
no.  from  beta  distribution 

Local  Variation  Description: 

SIGMA  I sigma  and  average  X for  .signature  extension  error, 

XBAR  j equations  C,  2b,  2c 

lER  error  flag  from  BETAD  subroutine 
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SUBROUTINE  SGEXT  BLOCK  DIAGRAM 
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•SUBROUTINE  CROP 
Purpose: 

This  subroutine  calculates  the  crop  calendar  error.  It  gets  a 
random,  number  from  a normal  distribution,  the  difference  between 
the  window  start  for'  the  zone  (from,  the  CROPW  file.)  and  the  actual 
window  start  for-  the  segment.  It  then  computes  a bias  and  sigma, 
including  this  random  number  and  quadratic  function  coefficients  in- 
putted from  control  cards.  It  also  computes  and  saves  values  for  the 
error  report. 

Input: 

/CAMSCM/  G(3,  2,  2)  quadratic  function  coefficients 

H(3,2,  2) 

/CROPW/  START(2,  4)  true  start  and  end  times  for 

END{2,  4)  windows  on  zone  level  plus 

SD(2)  standard  deviation  and  bias 

ERR(2,  5)  for  actual  start  of  segment 

within  zone 

Also  input  parameters. 

Output: 

/ERROR/  CROPF  error  factors  for  error  report 

CROPD 

Also  output  parameters. 

Linkage: 

GALL  CROP  (SEED (4),  TYPE,  SEASON,  WINDOW,  IFIRST,  BCC, 
SIGCC,  ITSEG) 


Inputs: 

SEED(4)  random  no.  seed  for  random  number  from  normal 

distribution  (double  precision) 

TYPE  which  component  of  mixed  crops,  integer  (1  = wheat, 

2 = mixed,  3 = other;  wheat  only  for  model  2) 

SEASON  which  kind  of  wheat  (winter,  spring),  integer 

WINDOW  which  window  acquisition  date  in  (1,  2,  3,  or  4),  integer 

IFIRST  .fl3.g  first  acquisition  window, 

= 1 for  first 
■ > 1 for  rest 
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Outputs: 

ITSEG 

BCC 
SIGCC 
SEED  (4) 


At  saved,  since  only  calculated  fox  first  acquisition 
in  each,  window  (equation  5d) 
bias  of  crop  calendar  error 
sigma  of  crop  calendar  error 

random  number  seed  after  used  to  calculate  DELTA, 
.double  precision  (used  only-for  first  acquisition  in 
•each  window) 


Subroutines  Used; 

CALL  BETAD  (SEED{4),  0,  0,  RN,  1,  lER)  for  returns  RJST,  a 

random  number  from  a normal  distribution,  from 
SEED  (4) . 

Local  Variable  Description: 

RN  random  no,  from  normal  distribution 

BGNSEG  I 

ENDSEG  > see  equations  B3,  5b-5d,  CAMS  Problem  Description 
TSTART  J 

lER  from  call  to  BETAD;  always  returns  0 
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SUBROUTINE ‘.CROP  BLOCK  DIAGRAM 


28234-6029-E.U-00 
Page  307 


SUBROUTINE  TSAVE 
Purpose: 

This  subroutine  handles  the  I/O  for  the  scratch  DA  file  TACQ, 


/ARGLST/NFATAL  TSAVE  has  fatal  error  if  too  many  records 
See  also  linkage. 
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Linkage: 

CALL  TSAVE  (ISEG,  lOPT,  IBAD) 

Inputs:  ISEG  segment  ID  no.  of  segment  being  written  or  read 

lOPT  =0  open  file 

= 1 read  file 

= 2 write  file 

=-i  close  file 

= 3 sort  index,  after  ail  writes 

IBAD  = 0 segment  found  and  read 

= 1 segment  not  found  to  read  (may  happen  when 

start  and  end  zones  specified) 

Subroutines  Used: 

CALL  RANACF  (IFILE,  IREC,  BUF,  N,  IX,  L,  lOPT)  to  use  CDC 
RA  routines. 

CALL  ERRMES  (4HCAMS,  5HTSAVE,  4,  I)  to  print  error  message. 

CALL  SORTAG  (IPOINT,  1,  IPEND,  IPNT2)  to  sort  files  IPOINT, 

IPNT2  as  IPOINT. 

Local  Variable  Description: 

IH  for  binary  search  - the  high  limit 

IL  for  binary  search  - the  low  limit 

ILOOK  for  binary  search  - the  current  guess 
L the  total  no.  of  records  allowed  in  file  TACQ 

NARG  no.  of  arguments  for  ERRMES  routine  (in'COMMON  /ARGLST/) 


SUBROUTINE  TSAVE  BLOCK  DIAGRAM 
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OPEN  FILE 

\ DCTIIDW  ♦ 

■CALL  RANACF 

CLOSE  FILE 


CLOSE  FILE 
CALL  RANACF 


RETURN 
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SUBROUTINE  CLASS 
Purpose: 

This  sabroatine  adds  the  input  classification  error  to  the  crop 
calendar  error  using  the  bias  and  sigma  from  the  CAL  ERR  file.  It 
then  computes  the  total  classification  error,  getting  a random  number 
from  a beta  distribution.  It  also  computes  and  saves  values  for  the 
error  report,  if  needed. 

Input: 


/CAMERR/  PW(3,4) 

BERR{3,4) 
SIGERR{3,  4) 

/CNTRL/  PRINTF 


/CAMSCM/  IREP 


See  also  linkage. 


from  CAMERR  input  file:  bias  and 
sigma  for  input  classification  error 


print  flag 

print  flag  for  error  report 


Output: 

/ERROR/ 


/TRAINS/ 


CLTOT(TYPE) 

CLBIAS(TYPE) 

CLRAND(TYPE) 

ERTOT(TYPE) 

ERBIAS{TYPE) 

ERRAND  (TYPE) 


> 


for  error  report:  equations 
B.  Id-lg,  2d-2f  from  CAMS 
Problem  Description 


TV(TYPE) 


. See  also  linkage. 

Linkage: 

CALL  CLASS  (SEED(2),  TYPE,  WINDOW,  M,  BCC,  SIGCC,  XI) 

Inputs: 

double  precision  random  no.  seed  used  to  generate 
classification  error  random  no.  from  beta  distribution 
integer,  which  component  of  mixed  crops  (1  = wheat, 

2 = mixed,  3 = other;  for  model  2,  1 = wheat  only  used) 
•integer,  which  window  current  acquisition  in  (1,  2,  3 or  4) 
output  from  MULTI  subroutine,  multi -temporal  error 

outputs  from  CROP  subroutine,  crop  calendar  error 


SEED(2) 

TYPE 

WINDOW 

M 

BCC 

SIGCC 
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Outpats: 

XI  total  error  factor 

SEED (2)  double  precision  random  no,  seed  after  use 

If  error  in  BETA  routine,  prints  message: 

BETA  DISTRIBUTION  ERROR  - FLAG  = X . ■ 

Subroutines  Used: 

■ CALL  BETAD  (SEED(2),  XBAR,  SIGMA,  XI,  0,  lER)  to  get  random 

number  from  beta  distribution. 

SQRT(X)  square  root  function 

CALL  ERRMES  (4HCAMS,  5HCLASS,  4,  0)  to  report  error  in  BETA 
routine . 

Local  Variable  Description: 

bias  and  sigma  of  input  classification  plus  crop  calendar 
errors,  equations  3a,  3b 

total  error  bias  and  sigma,  equations  2b,  2c 


S 

SIG 

XBAR 

SIGMA 

lER 


} 


SUBROUTINE  CLASS  BLOCK  DIAGRAM 
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CLASS 


ADD  INPUT  CLASSIF. 
TO  CROP  CALENDAR 
error;  ’B  and  SIG: 
EQN‘s.  3a,  3b 


ALL  EQUATIONS  FROM 
CAMS  PROBLEM 

DESCRIPTION,  SECTION  3.3, 


COMPUTE  XBAR,  SIGMA 
EQN'S  2b,  2c 


GET  TOTAL  ERROR  XI 
CALL  BETAD 
EQN  2a 


BAD  ^ 
RESULT? 
FLAG  f 0 


XI  = XBAR 
CALL  ERRMES 


ERROR  REPORTr 
PRINTF^  0 
OR  . 
s.  IREP  s 0^/ 


RETURN 
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SUBROUTINE  INPT 
Purpose: 

This  subroutine  sets  up  the  next  records  to  process  on  the  five 
input  files.  It  keys  on  the  SEGTRU  file.  The  data  is  set  up  differently 
depending  on  the  model  being  used  for  .some  files.  Some  range  checks 
are  done.  The  reading  of  each  file  can  be  bypassed  to  handle  error 
condition  bypassing  and  the  data  requirements  of  each  pass  (training 
segments,  ordinary  segments,  special  cases  - no  acquisition  file  or 
no  training  segment  ID  match),  Asa  side  effect  of  the  ordinary  seg- 
ment read  pass,  training  segments  are  outputted  to  the  output  file 
CAMSF,  At  the  return  of  INPT  to  CAMS,  all  necessary  data  is  present 


and  ready  to  use. 
Input : 

/FILES/ 

TACQ 

SEGTRU 

ACQUIS 

CAMERR 

CROPW 

SIGEXT 

CAMSF  ^ 

> 

y logical  file  unit  nos.  , integers 

• 

LCAMSF 

length  of  output  record  

/INDX/ 

INDEX 

index  for  RA  scratch  file  TACQ 

/LEMCM/ 

ENDZ 

ENDR 

zone  and  region  to  end  processing  at,  integers 

■ /CAMSCM/ 

IWIND 

which  window  to  use  for  recalculation  of 
PT(M)  if  needed 

IMODEL 
See  also  linkage. 

which  model  (1  or  2) 

Output: 

Records  for  each  input  file  are  outputted,  unless  bypassed,  in 
C OMMON- blocks , See  Section  2.4  of  the  Users  Manual  for  the  file 
descriptions,  and  Programmers  Manual  for  the  COMMON  block 
descriptions. 
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/SEGTRU/  C0UN4 
IREG4 

IZONE4  holds  1 record  from  SEGTRXJ  file 

ISTR4 

ISUB4 

ISEG4 

IT 

IPRIOR(6) 

ISPW 

PT(2)  PT(2)  will  be  recalculated  if  file  input 

out  of  range 

If  PT(2)  * PW(2,IWIND)  <{PT(2)  + PT(1)  - 100) 


then 


PTfZ'l  = IQO  - PT(1) 

' ^ 100  - PW(2,IWIND) 


If  PT(2)  * PW(2,IWIND)  > PT{1)  then 


PT{2)  = 


PT(1) 

PW(2,  IWIND) 


/CAMERR/ 

COUN2 
IREG2 
.IZONE2 
ISTRA2 
ISUBST2 
ISEG2 
PW(3,  4) 
BERR{3,  4) 
SIGERR(3,  4) 

holds  1 record  from  CAMERR  file 
if  model  1,  last  2 words  of  file  ignored 

(^PW’  ^PW^ 

if  model  2,  middle  6 words  ignored  from 

(%/W’ V/W’  ®W/0’ V/O’  ^W/M’ 
% /M>  ^PW’  ^PW  stored  in  wheat 

dimension  of  BERR,  SIGERR;  also  PW 
for  wheat  reset  to  PT  (wheat) /lOO;  PW 
for  mixed  reset  to  0 

/ACQUIS/  • 

COUNl 

IREGl 

IZONEl  holds  1 record  from  ACQUIS  file 

ISTRAl 
■ ISUBSTl 
ISEGl 
IWIN{4,  25) 

ITOTAL 

/CROPW/  • 

COUN3 
IREG3 
IZONE3 
ISTRA3 
ISUBST3  . 

START{2,4) 
END(2,  4) 
SD(2] 

ERR(2,  5) 

i read  in  groups;  see  file  description, 
r Section  2.4  of  the  Users  Manual. 
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/SIGEXT-/ 

COUN5 
IREG5 
IZONE5 
ZB(3,  2) 
ZSIG(3,  2,  6) 

holds  1 record  from'  SIGEXT  file 

if  model  1,  ignore  model  2 data 

if  model  2,  store  in  wheat  dimension  and 

ignore  model  1 data 

ZB(I,  1)  = ZB(I,  1)  + 1 for  all  ZB's  for 

dimension  1 

/ARGLST/ 

NERRS 
NFA  TA  L 
NPERRS 

error  count  passed  back  from  ERRMLT 
subroutine 

/INDX/ 

INDEX 

index  for  RA  scratch  file  TACQ 

/STATS/ 

NREC(2) 

NREC(4) 

NREC(6) 

NREC(7) 

NCAMSR 

no,  of  records  processed  for  input  files 

See  also  linkage. 

Linkage; 

CALL  INPT  (ISEG,  lACQU 
lEND) 

, ICAMER,  ICROPW,  ISGEX,  IPASS,  IDONE 

Inputs: 

ISEG 

lACQU 

ICAMER 

ICROPW 

ISGEX 

J 

flags  for  input  files 
f 0 read  file 

^0  skip  reading  file 

IPASS 

which  pass, 

0 = special  cases 

1 = training  segment  pass 

2 = ordinary  segment  pass 


Outputs: 

IDONE  flag  0 

1 
2 

lEND  flag  0 

1 

Subroutines  Used: 

CALL  ERRMES  (4HCAMS,  3HINP,  8,  1)  to  report  error  message. 

CALL  TSAVE  (ISEG,  1,  IBAD)  to  write  record  from  scratch  RA 
file  to  output  file. 


= normal  return 
= end  of  file  reached 
= error  return 

= end  zone  has  not  been  reached 
= end  zone  has  been  reached 
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Local  Variable  Description: 


W 

M 

/ARGLST/NARG 


= 1,  wheat  component 
=2,  mixed  component 
for  error  subroutine  ERRVES 


•ITOTAL  ■ 

ISKIP 

lEND 


no.  of  filler  words 

used  to  skip  over  words  ’ 

flag  to  signal  end  zone  has  been  reached, 

0 = not  yet,  1 = has  been  reached 


SUBROUTINE  INPT  BLOCK  DIAGRAM 
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READ  RECORD 
READ  (SEGTRU) 


I DONE  = 2 

-f>|  CALL  ERRMES- 
ENDING  REGION 
AND  ZONE  NOT  FOUND 
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CAS  SUBROUTINE  DESCRIPTIONS 
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Subroutine  CAS 


Purpose : 

CAS  is  the  driver  for  the  CAS  simulator,,  It  coi  trols  the  looping 
for  the  bio -windows,  and  prediction  datesjcalling  CASPP  to  perform  the 
CAS  computations  for  each  bio-window  and  each  prediction  date. 


Input: 

Common 

Quantity 

Block 

Source 

BWIND 

CASCM 

CASIN 

NPDATE 

CASCM 

CASIN 

PRDATE 

CASCM 

CASm 

PRINTF 

CONTRL 

LEM  (SETPRF) 

NFATAL 

ARGLST 

ERRMES 

Output: 

Common 

Quantity 

B lo  ck 

Source 

IBW 

CASFLG 

GROUP, 

CAS2 

IPD 

CASFLG 

GETYS, 

CAS2 

GROUP 

_ PPFLG 

CASFLG 

GETYS, 

CAS2 

GROUP 

PPDATE 

CASFLG 

GETYS, 

GROUP 

Linkage: 

CALL  CAS 

Subroutines  Used: 

CASINT 

CASPP 

SUMREP 

Local  Variables: 


None 


CAS  Flow  Diagram 
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Subroutine  CASPP 


Purpose: 


Subroutine  CASPP  performs  the  first  pass  CAS  computations  • 
generating  data  sets  1-9.  It  also  calls  CAS2  to  compute  the  estimated 
group  1,2  area  variances  and  calls  CAS3  to  generate  data  sets  10-19. 

Input: 

Common 


Quantity 

Block 

File 

Source 

NFATAL 

ARGLST 

ERRMES 

IRREG 

CASFLG 

CASINL 

IPP 

CASFLG 

CASINT 

LDS  4 

CASFLG 

Block  Data 

LDS  7 

CASFLG 

Block  Data 

LDS  8 

CASFLG 

Block  Data 

LDS  9 

CASFLG 

Block  Data 

NSTART 

CNTRL 

LEM 

IMXSEG 

CONST 

Block  Data 

ENDFIL 

CONST 

Block  Data 

STRATA 

DSET4 

YESOUT 

GETYS 

ZONE 

DSET7 

YESOUT 

GETYS 

REGION 

DSET8 

YESOUT 

GETYS 

TWAR 

DSET8 

DS7 

HWARI 

DSET8 

DS7 

EWARi 

DSET8 

DS7 

DSET8 

DSET8 

DS7 

CASDSF 

FILES 

Block  Data 

LCASDS 

FILES 

Block  Data 

ISUBH2 

FILES 1 

Block  Data 

LSUBH2 

FILES  1 

Block  Data 

LIXSSH 

IXSUBH 

Block  Data 

LIXCDS 

IXCDSF 

Block  Data 

ENDR 

LEMCM 

INPUT 

ENDZ- 

LEMCM 

' INPUT 

SSHDTA 

SSHDTA 

ISUBH2. 
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Common 


Quantity 

Block 

File 

Source 

COUN2 

SSHDTA 

ISUBH2 

IREG2 

SSHDTA 

1SUBH2 

See  description 

• 

• 

• 

• 

• 

« 

• 

« 

* • 

of  ^SSHDTA/ 

CV4 

SSHDTA 

ISUBH2  , 

. 

CLASS 

SSHDTA 

ISU  BH2 

NT  =ITER 

STATS 

- 

LEM 

YSTR 

YESDTA 

YESOUT 

GETYS 

Output': 

Common 

Quantity 

Block 

File 

U sed  By 

IPP 

CASE  LG 

CAS2 

KSUB 

CASE  LG 

DS123 

DSET4 

DSET4 

DS456,  CAS2 

DSET7 

DSET7 

DS7,  CAS2 

DSET8 

DSET8 

CASE 

DSET9 

DSET9 

CAS2 

ARG(l) 

ARGLST 

ERRMES 

NRSSH 

CASELG 

WRAPUP 

IRREG 

CASELG 

RANACF 

NREGS 

CASELG 

CAS2 

ER 

DSET8 

CAS2 

EC 

DSET9 

CAS2 

MIMZZC 

DSET9 

CAS2 

HWACl 

DSET9 

CAS2 

EWACl- 

DSET9 

CAS2 

Linkage: 


CALL  CASPP 
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Subroutines  Used: 

CASINL 
CLASSN 
GETYS 
' ERRMES 
- DS123 

DS45  6 
DS7 

RANACF 

CAS2 

CAS3 

Processing; 

See  Flow  Diagram  on  the  following  pages. 


CASPP 
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Initialization 

Position  Files,  Initialize 
Flags  and  Counters, 
Determine  Substrata  Classes 


YES 

Output 

File 


Read  YES 
Data 


FOR  EACH  SUBSTRATA 


IN  THE  STRATA 


Read  Substrata 
Historical  Data 


Substrata 

Historical 

File 


CAMS 

Output 

File 


/Test\^ 
Substrata 
Group  No. 


FOR  EACH  SEGMENT  \ 
IN  THE  SUBSTRATA 


Read  Segment  Data 
from  CAMS  File 


Read  Segment  Data 
from  CAMS  File 


Aggregate  Segment 
Data  in  Data  Set  1 
(Substrata  Level) 


Aggregate  Segment 
Data  in  Data  Set  2 
(Substrata  Level) 


Aggregate  Substrata 
Data  (Data  Set  1)  up  to 
Strata  Level  (Data  Set 4) 


Ag  gr  ega  te  ■ Sub  s tra  ta 
Data  (Data  Set  2)  up  to 
Strata  Level  (Data  Set  5) 


Aggregate  Substrata 
Data  (Data  Set  3)  up  to 
Strata  Level  (Data  Set  6) 
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Group  II 
Segments 
Acquired  in 
V Strata 


Add  Data 
Set  5 to 
Data  Set  6 


Aggregate  Strara 
Data  (Data  Sets  4,5,6) 
up  to  Zone  Level 
(Data  Set  7) 


TO  NEXT 
STRATA 


Any\^ 
More  Strati 
^ in  Zone  / 


Aggregate  Zone 
Data  (Data  Set  7) 
up  to  Region 
Level  (Data  Set  8) 


TO  NEXT 
ZONE 


X Any 
More  Zon^ 
in  Region 

\ ? X 


/C^ 


Aggregate  Regior 
Data  (Data  Set  8] 
up  to  Country 
Level  (Data  Set  9] 


TO  NEXT 
REGION 


Regions  in 
s^Country  > 


Call  CAS2  to 
Determine  Esti- 
mated Group  1,  2 
Variances 


RETURN 


Call  CAS3  to 
Compute  Data 
Sets  10-19 


CASPP  Flow  Diagram  (Sheet  2 of  2) 
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Subroutine  CASOUT 


Purpose: 

Subroutine  CASOUT  processes  the  CAS  Output  d;.ta  for  the  CAS 
Area  and  Production  Summary  Report  and  the  CAS  Country  Summary 
Report.  It  converts  data  to  output  units,  computes  mean  values,  and 
on  option  prints  a portion  of  the  Area  and  Production  Summary  Report. 


Input : 


Quantity 


Common 

Block  Source 


ILEVEL  • 

bUTP 

AREACF 

YCF 

PRDCF 

APREP 

CASCUM 

IREG 

IZONE 

ISTRA 

HWA 

TWA 

EWA 

A ERR 

AVAR 

TPROD 

EPROD 

PRERR 

PRVAR 

TY 

EY 


Calling  sequence 
parameter 

FILES 

CASCM 

CASCM 

CASCM 

CASCM 

CASCUM 


■ CAS2,  DSIO 

Block  Data 

CASIN 

CASIN 

CASIN 

CASIN 

DSIO,  CAS2 
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Common 

Quantity  Block  Source 

YERR  CASCUM  DSIO,  CAS2 

ANAV 

ANPRV 

SQAER 

S'^PER 

SQYER 

CLEWA 

CLEPRD 

CLATEC 

CLP TEC 

CLATWC 


CLPTWC 

IPP 

CASFLG 

LEM 

ENDREG 

CASFLG 

CAS2 

NLINE 

PAGECM 

PAGER 

MXLINE 

PAGECM 

PAGER 

NT 

STATS 

LEM 

NSTRAZ 

DSET7 

CAS2 

Output;  , > 

1)  Printed  Output 

Quantity 

Common 

Block 

IREG 

CASCUM 

IZONE 

CASCUM 

ISTRA 

CASCUM 

TWA 

CASCUM 

EWA 

CASCUM 

CTl 

CT2 

CT3 

MU 

M2J 
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Common 

Quantity  Block 


CVAEPT 

CVEPTA 


TY 

CASCUM 

EY 

CASCUM 

SDPER 

CASCUM 

TPROD 

, CASCUM 

EPROD 

CASCUM 

CVPEPT  • 

CVEPTP 

2)  Output  to  Common  Blocks 

Common 

> 

Quantity 

Block 

Used  By 

SQAER 

CASCUM 

DS18 

SQPER 

CASCUM 

DS18 

TWA 

CASCUM 

DS18 

EWA 

CASCUM 

DS18 

AERR 

CASCUM 

DS18 

TPROD 

CASCUM 

DS18' 

EPROD 

CASCUM 

DS18 

PRERR 

CASCUM 

DS18 

CSUMR 

SUMDTA 

SUMREP 

Note:  The  quantities  SQAER,  SQPER,  ...  , PRERR  are  converted 
from  the  internal  units  (hectares  and  quintals)  to  the  appro- 
priate output  units.  In  addition,  the  mean  values  of  TWA, 
EWA,  AERR,  TPROD,  EPROD,  and  PRERR  are  computed. 

Linkage: 

CALL  CASOUT  (ILEVEL) 
where 

ILEVEL  =0  for  country, 

= -l  for  region, 

= -2  for  zone, 

for  n^  strata  in  zone 


=+n 


Subroutines  Used: 
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APHDR  - Prints  Area  and  Production  Summary  Report  headers 
PAGER  - Automatic  paging  routine 

SQRT  ~ Square  root  routine 

Processing: 

1.  Convert  units  from  internal  units  to  appropriate  output  units 
and  compute  mean  values;  e.  g. , 

HWA  = HWA  AREACF/NT 

AVAR  = AVAR  AREACF^>1=2/NT 

TPROD  = TPROD  * PRDCF/NT 

« 

■ 

PRVAR  = PR  VAR  ={=  PRDCF>!=*2/NT 
TY  = TY  - YCF/NT 

MU  = MIJ/NT 


CT3  = CT3/NT 

ANAV  = ANAV  =1=  AREACF=i^=i=2/NT 
ANPRV  = ANPRV  * PRDCF**2/NT 
SQAER  = SQAER  ^ AREACF=5=^2 
SQPER  = SQPER  PRDCF^^icg 
SQYER  = SQYER  YCF>:'^2 


2.  If  I LEV  EL  = 0 (country  level),  compute  average  values  of 
confidence  levels;  e.  g.  , 

CLEWA  = CLEWA/NT 

3.  Compute  coefficients  of  variance  for  Country  Summary  Report 

© CVAEPT  = * 100 

CVAreaEst."] 

{%  True) 


CVPEPT  = 100 


CV  Prod.  Est. 
(%  True) 
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© CVEPTA  = 

"Area 
CV  Error 
.{%  True 


Yield 
Std.  Dev. 
_(%  True)  _ 


CVEPTP  = 


Prod. 

CV  Error 
(%  True) 


4.  If  APREP  4 0,  then  one  data  line  is  printed  for  the  Area  and 
Production  Summary  Report,  For  the  first  strata  of  each 
zone,  the  data  line  may  be  preceded  by  several  lines  of 
identification  information  such  as  the  input  problem  header, 

the  bio -window  number  or  prediction  date,  the  current  iteration 
number,  and  data  levels, 

5.  Finally,  if  ILEYEL  = 0 (country  level),  values  are  saved  in  the 
array  CSUMR  for  the  current  prediction  for  later  printout  in 
subroutine  SUMREP. 
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Subroutine  CAS2 


Purpose: 

• Subroutine  CAS2  computes  the  area  variances  and  analytic  area 
variances  for  all  strata  which  have  acquired  segm'ents.  CAS2  also 
aggregates  quantities  at  the  zone,  region,  and  country  levels  which  will 
be  used  to  compute  the  area  variances  for  strata  without  acquired 
segments. 


Input: 


Quantity 

IPRD 

PPFLG 

IBW 

IPD 

IPP 

NREGS 

ISUBH2 

LSDBH2 

'MXCL.SS 

DSET4 

HWASl 

XMIJS 

XCTIS 

ANVSI 

HWAS2 

XM2JS 

XCT2S 

ANVS2 

T 

HWAS3 

XCT3S 


Common 

Block 

CASCM 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

FILES  1 

FILESl 

FILESl 

DSET4 


. 

DSET4 


File  Source 

CASIN 

CAS,  C A SINT 
CAS 
CAS 
CAS 
CASPP 
Block  Data 
Block  Data 
Block  Data 
ISUBH2  DS456 


'H  'f 

ISUBH2  DS456 
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. Input;  (cont'd) 

Common 

Quantity  Block  File  Source 

DSEX7  DSET7  ISUBH2  DS7 

MIK2KZ 
NSTRAZ 
M1K2CL 


SSQ 

DSET7 

ISUBH2 

DS7 

DSET8 

DSET8 

ISUBH2 

CASPP 

M1K2KR 

DSET8 

ISUBH2 

CASPP 

NZONES 

DSET8 

ISUBH2 

CASPP 

DSET9 

DSET9 

ISUBH2 

CASPP 

M1K2KC 

DSET9 

ISUBH2 

CASPP 

QUTP 

FILES 

Block  Data 

CASDSF 

FILES 

Block  Data 

LCASDS 

FILES 

Block  Data 

LIXCDS 

IXCDSF 

Block  Data 

BIXSSH 

IXSUBH 

> 

Block  Data 

SSHDTA 

SSHDTA 

ISUBH2 

DS123 

GRPNO 

SSHDTA 

ISUBH2 

DS123 

,-VMULTK 

SSHDTA 

ISUBH2 

DS123 

'CLASS 

SSHDTA 

ISUBH2 

CLASSN 

Common 

Block 


NRSSH 

CASFLG 

IRSTR 

IRZONE 

V ■ 

IRREG 

CASFLG 

DSET4 

DSET4 

V1V2S 

VARS 

■ 

ANVARS 

r 

DSET4 
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Outpat;  (cont'd) 


Quantity 

DSET7 

ANALVZ 

HWAZ3 

ESTVZ 

DSET8 

ANALVR 

ESTVR 

DSET9 

ANALVC 

ESTVC 

Linkage: 

CALL  CAS2 

Subroutines  Used: 

PAGER 

RANACF 

Local  Variables: 

. I 

I 

IREG 
IZONE  - 
ISTRAZ  - 
NSUB 
ISUB 

TAU2S  - ' 
ICL 

Processing: 


Common 

Block  File  U sed  By 


DS 


:T7 


CASDSF  CAS3,  DSIO 


V 

DSET7 

DSET8 

DSET8 

DSET8 

DSET9 

DSET9 

DSET9 


V' 

CASDSF 

CAS3,  DSIO. 

CASDSF 

CAS3,  DSIO 

CASDSF 

CASS,  DSIO 

CASDSF 

CAS3,  DSIO 

CASDSF 

CASS,  DSIO 

CASDSF 

CASS,  DSIO 

CASDSF 

CASS,  DSIO 

Index  in  DO  loops 
Region  index 
Zone  index 
Strata  index 

Number  of  substrata  in  the  current  stratum 
Substrata  index 


Substrata  class  index 


See  Flow  Diagram 
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CAS2 


Any 

acquisitions 
Svin  country 


28234-6029-RU-51 


fTa  1 


4a 
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Subroutine  CAS 3 


Purpose: 

CASS  performs  the  final  pass  CAS  computations  generating  data 


sets  10-19. 

Input: 

Common 

Quantity 

Block 

File 

Source 

NFATAL 

ARGLST 

ERRMES 

DISTFF 

CASCM 

CASIN 

A PREP 

CASCM 

CASIN 

IPRD 

CASCM 

CASIN 

C A SCUM 

CASCUM 

CASCUM 

RWCASF 

ICASC 

CASCUM 

CASCUM 

RWCASF 

DSET15 

CASCUM 

CASCUM 

RWCASF 

DSET16 

CASCUM 

CASCUM 

RWCASF 

DSET17 

CASCUM 

CASCUM 

RWCASF 

SQAERS 

CASCUM 

CASCUM 

RWCASF 

SQPERS 

CASCUM 

CASCUM 

RV7CASF 

SQYERS 

• 

• 

CASCUM 

• 

• 

CASCUM 

•«  4 

• 

RWCASF 

• 

• 

SQYERC 

« 

CASCUM 

4 

CASCUM 

• 

RWCASF 

PPFLG 

CASFLG 

CAS 

IBW 

CASFLG 

CAS 

IPD 

CASFLG 

CAS 

IPP 

CASFLG 

• 

CAS 

NREGS 

CASFLG 

CAS 

LDS  11 

CASFLG 

CAS 

EDS  12 

CASFLG 

CAS 

LDS  13 

CASFLG 

CAS 

LDS  15 

. CASFLG 

CAS 

LDS  16 

CASFLG 

CAS 

LDS  17' 

CASFLG 

CAS 
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Quantity 

• Common 
Block 

PRINTF 

CNTRL 

DSET7 

DSET7 

ZONE 

DSET7 

NSTRAZ 

DSET7 

DSET8 

DSET8 

REGION 

DSET8 

DSET9 

DSET9 

DSETll 

DSETll 

TWAZ 

DSETll 

EWAZ 

DSETll 

TPRODZ 

DSETll 

EPRODZ 

DSETll 

OUTP 

FILES 

CASDSF 

FILES 

LCASDS 

FILES 

LIXCDS 

IXCDSF 

NTRIAL 

LEMCM 

MXLINE 

PAGECM 

NT^ITER 

STATS 

Output: 

Quantity 

Common 

Block 

CASCUM 

CASCUM’ 

DSET15 

CASCUM 

DSET16 

CASCUM 

DSET17 

CASCUM 

IRSTR 

CASE  LG 

IRZONE 

CASFLG 

IRREG 

CASFLG 

ENDREG 

CASFLG 

DSETll 

DSETll 

AERRZ 

DSETll 

PRERRZ 

DSETll 

File 

Source 

SETPRF 

CASDSF 

CASPP 

CASDSF 

■ CASPP 

CASDSF 

CASPP 

CASDSF 

CASPP 

CASDSF 

CASPP 

CASDSF 

CASPP 

DSIO 

DSIO 

DSIO 

DSIO 

DSIO 

Block  Data 
Block  Data 
Block  Data 
Block  Data 
LEMCF 
Block  Data 
LEM 


File 

U sed  B-) 

CASCUM 

RWCASF 

CASCUM 

RWCASF 

CASCUM 

RWCASF 

CASCUM 

RWCASF 

DSIO 

RWCASF, 

RANACF 

RWCASF, 

RANACF 

CASOUT 

CASDIS 

RWDISF 

CASDIS 

RWDISF 

CASDIS 

RWDISF 
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Common 


Quantity 

Block 

File 

TYZ 

DSETll 

CASDIS 

EYZ 

DSETll 

CASDIS 

YERRZ 

DSETll 

CASDIS 

DSET12 

DSET12 

CASDIS 

AERRR 

DSET12 

CASDIS 

PRERRR 

DSET12 

CASDIS 

PRVARR 

DSET12 

CASDIS 

TYR 

DSET12 

CASDIS 

EYR 

DSET12 

CASDIS 

YERRR 

DSET12 

CASDIS 

DSET13 

DSET13 

CASDIS 

NPAGE 

PAGECM 

Linkage; 

CALL  CASS 

Sabroutines  Used; 

PAGER 

RANACF 

DSIO 

RWCASE ' 

RWDISF- 

CASOUT 

CONFL 

DSIO 

Local  Variables: 

I - Index  in  DO  loops 

IREG  - Region  counter 

IZONE  - Zone  counter  (within  a region) 

Processing; 

See  Flow  Diagram. 


U sed  By 

RWDISF 

RWDISF 

RWDISF 

RWDISF 

RWDISF 

RWDISF 

RWDISF 

RWDISF 

RWDISF 

RWDISF 

RWDISF 

PAGER 


CAS  3 
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Any 

'Acquisitions  u 
untry^/^ 


RETU 


TO  NEXT  STRATA 


Accumulate  Strata 
Data  in  Data  Set  14 
(CAS  Cum  File) 


Print 


Print  Strata 
Portion  of  Area 
and  Production 
Summary  Report 


Any  ^ 
More 
Strata  in 
\ Zone/'' 


CAS 3 Flow  Diagram  (Sheet  1 of  4) 
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i 

Aggregate  Zone 
Data  (Data  Set  11) 
up  to  Region  Level 
(Data  Set  12) 


% 

Accumulate  Zone 
Data  in  Data  Set  15 
(CAS  Cum.  File)' 


i 

Enter  Zone  Data 
into  Data  Set  19 
(CAS  Dist,  File) 


28234- 6029 -RU-5i: 


CAS3  Flow  Diagram  {Sheet  3 of  4) 
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'Subroutine  GETYS 


Purpose: 


Subroutine  GETYS  reads  strata  yield  data  from  the  YES  output  file 


(YES)  and  obtains  .the  proper  value  of  estimated  yield  for  the  current 
bio -window  or  prediction  date. 


Input: 


Common 


Quantity 

Block 

File 

Source 

PPFLG 

CASE LG 

CAS 

IPD 

CASE LG 

CAS 

PPDATE 

CASE LG 

CAS 

NSTRAT 

CASE  LG 

CASINL,  DS456 

NRYES 

CASE LG 

CASINL 

NSTART 

CNTRL 

LEM 

ENDFIL 

CONST 

Block  Data 

STRATA 

DSET4 

YESOUT 

YES 

EVYRS 

DSET4 

YESOUT 

YES 

ZONE 

DSET7. 

YESOUT 

YES 

REGION 

DSET8 

YESOUT 

YES 

YS 

DSETIO 

YESOU  T 

YES 

ESTYS 

DSETIO 

YESOUT 

YES 

YESOUT 

FILES 

Block  Data 

• IREG2  ■' 

SSHDTA 

SUBHST 

CASPP 

IZONE2 

SSHDTA 

SUBHST 

CASPP 

• -ISTRA2 

' SSHDTA 

SUBHST 

CASPP 

NT 

STATS 

LEM 

YSTR 

YESDTA 

YESOUT 

YES 

IZPRDD 

YESDTA 

YESOUT 

YES 

YSCI 

YESDTA 

YESOUT 

YES 

YSYCI 

• YESDTA 

YESOUT 

YES 

YCOUN 

YESOUT 

YES 
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Output; 

Quantity 

Common 

Block 

U sed  By 

NRYES 

CASE  LG 

WRAPUP 

STRATA 

DSET4 

CASPP,  DS4'--6 

EVYRS 

DSET4 

DS45  6 

ZONE 

DSET7 

CASPP,  DS7 

REGION 

DSET8 

CASPP 

YS 

DSETIO 

DS456 

ESTYS 

DSETIO 

DS^56 

Linkage; 

CALL  GETYS 
Subroutines  Used: 

ERRMES 
Local  Variables': 

I - Index  in' DO  loop 

n . - 1-6 

YCOTJN  - Country  ID  read  from  YESOUT  file 
Processing: 

1,  Advance  NRYES  by  1 and  read  one  data  record  from  YESOUT 
file. 

2,  Check  for  end-of-data  indicator  (country  ID  = 4H  ZZZZ).  If 
end-of-data  read,  call  ERRMES  to  write  error  message  and 
abort  run. 

3,  If  first  iteration  of  current  run  and  if  not  first  strata  in  country, 
compare  region,  zone  and  strata  ID's  from  YESOUT  and  SUBHST 
files.  If  any  pair  does  not  agree,  call  ERRMES  to  write  error 
•message  and  abort  run. 

4,  If  PPFLG  = 0 (bio-window),  then  find  last  non-zero  yield  date 
from  the  YESOUT  file  for  the  current  strata.  Save  the  cor- 
responding value  of  estimated  yield  in  ESTYS  and  sav^'e  the 
corresponding  value  of  yield  variance  in  EVYRS.  Then  return. 
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5,  If  PPFLG  4 0 (prediction  date),  then  find  the  last  non-zero 
yield  date  which  is  less  than  or  equal  to  the  given  prediction 
date.  Save  the  corresponding  estimated  yield  in  ESTYS  and 
save  the  corresponding  yield  variance  in  EA^^YRS,  If  the 
given  prediction  date  is  less  than  all  yield  dates  for  this 
strata,  then  a flag  is  set  so  CAS  will  skip  this  strata. 


6.  Return, 
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Subroutine  GROUP 


Purpose: 

Subroutine.  GROUP  reads  segment  data  from  the  CAMS  output  file 
(CAMSF),  selects  the  estimated  proportion,  wheat  for  the  proper  bio- 
window for  each  segment,  and  aggregates  the  segment  data  up  to  the 
substrata  level. 


Quantity 

Common 

Block 

File 

Source 

W PRIOR 

CASCM 

- 

■ CASIN 

. PPFLG 

CASFLG 

CAS 

IBVf 

CASFLG 

CAS 

PPDATE 

CASFLG 

CAS 

NRCAMS 

CA'SFLG 

CASINL 

MIK 

DSETl 

DS123 

EPWK 

DSETl 

DS123 

EPW2K 

DSETl 

DS123 

SMPKPI 

DSETl  ■ 

DS123 

SUMPK2 

DSETl 

DS123 

SUMPK 

DSETl 

DS123 

CAMSF 

FILES 

Block  Data 

IDSEGT. 

SEGDTA 

CAMSF 

CAMS 

ISEG 

■ SEGDTA 

’CAMSF  ' 

CAMS 

TPWKI 

SEGDTA  ■ 

CAMSF 

CAMS 

ZACDAY 

SEGDTA 

CAMSF 

CAMS 

EPWKI 

. SEGDTA 

CAMSF 

CAMS 

ERRPWI  ’ 

SEGDTA 

CAMSF 

CAMS 

IREG2 

SSHDTA 

CASPP 

I-ZONE2 

SSHDTA 

CASPP 

ISTRA2 

SSHDTA 

.CASPP 

JSUBS2 

SSHDTA 

CASPP 

NSEG 

SSHDTA 

CASPP 

HISTPW 

SSHDTA 

CASPP 
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Output; 


Quantity 

Common 

Block 

MIK 

DSETl  [ 

Values  share  same  location;  one  or 

M2K 

DSETl i 

the  other  is  computed. 

EPWK 

DSETl 

EPW2K 

DSETl 

SMPKPI 

DSETl 

SUMPK2  ■ 

DSETl 

SUMPK 

DSETl 

Linkage; 

- CALL  GROUP 
, Local  Variables: 


I 

N 

ESTPWI 


Index  in  DO  loop 
Index  in  segment  DO  loop 

Specific  value  of  estimated  proportion  wheat  (fraction) 
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RETURN 
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Subroutine  SUMREP 


Sabroutine';,SUMRjKP  prints  the  Country  Summary  Report,  a two  page 
printed  report  which  specifies  the  mean  values  of  the  estimated  wheat 
area,  y eld,  and  production,  coefficients  of  variance,  and  confidence  levels 
at  the  country  level  for  each  bio -window  and  prediction  date. 


Common 

Block 


Sour ce 


OUTP 

FILES 

- Block  Data 

CUNTRY 

LEMCM 

INPUT 

MXLINE 

PAGECM 

Block  Data 

NT 

• STA  TS 

LEM 

AREACE 

CASCM 

CASIN 

YCF 

CASCM 

CASIN 

PRDCF  - 

CASCM 

CASIN 

APRUTS 

CASCM 

CASIN 

PPRUTS 

CASCM 

CASIN 

YPRUTS  ■ 

CASCM 

CASIN 

AUNITS 

CASCM 

CASIN 

BWIND 

CASCM 

CASIN 

IPRD 

CASCM 

CASIN 

NPDATE 

CASCM 

CASIN 

HWAC 

DSET13 

CAS2 

TWAC 

DSET13 

CAS2 

TPRODC 

■ DSET13 

CAS2 

TYC 

DSET13 

CAS2 

CSUMR 

■ -SUMDTA 

CASOUT 
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Output; 


Printed  output 

CUNTRY 

CSUMR 

NT 

HWAC 

A PRUTS 

TWAC 

YPRUTS 

TYC 

PPRUTS 

TPRODC 

IPRD 

Output  to  common 

Quantity 

Common 

Block 

-Used  By 

NLINE 

PAGECM 

PA  GER 

Linkage: 

CALL  SUMREP 

Subroutines  Used: 

EJECT 

PAGER 

Local  Variables: 

I - Index  in  DO  loop,  e,  g. , bio -window  number 
INDX=.  A UNITS  + 1 

Processing: 

1.  Call  EJECT  to  eject  page  and  print  page  headers. 

2.  Print  labels  for  Country  Summary  Report. 

3.  Print  country  ID  and  Monte  Carlo  iteration  number. 

4.  Print  output  labels  (including  units  labels  for  first  x^^ige  only). 

5.  Print  country  summary  data  for  each  bio-window  and  each 
prediction  point. 
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First  Page 

Bio -window 
or 

prediction 


Est. 

CV 

CV 

CV  Area 

WA 

Anal,  WA  • 

Area  Est. 

Error 

(Pet  True) 

(Pet  True) 

(Pet  True) 

Est. 

Std.  Dev. 

Yield 

Pet  Error 

Est. 

CV 

CV 

CV 

Prod. 

Anal,  Prod 

Prod.  Est. 

Prod.  Error 

(Pet  True) 

(Pet  True) 

(Pet  True) 

Second  Page 

Bio-window  CL  Area 

or  True/Error 

prediction 
date 


CL  Area 
Est/Est 


CL  Area  CL  Area 

True/Est  True/WC 


CL  Prod,  CL  Prod, 

True/Error  Est/Est 


CL  Prod,  CL  Area 
True/Est  True/WC 


6.  At  the.  bottom  of  the  first  page  print 


Historical  wheat  area 
True  wheat  area 
True  yield 
True  production 


Note:  Steps  1-5  are  performed  for  Page  1 and  Page  2 of  the  Country 

Summary  Report. 
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Subroutine  TSUB 


Purpose : 

Subroutine  XSUB  computes  the  quantity  T,  which  is  the  second 
term  of  the  PPS  area  variance  equation. 

Input: 


Common 


■ Quantity 

Block 

Sour ce 

XM2JS 

DSET4 

DS123 

HWAS2 

DSET4 

DS123 

HWA2K 

CASCUM 

DS123 

■ WAKNEY 

CASCUM 

DS123 

T 

DSET4 

DS456 

Output: 

Quantity 

Common 

Block 

U sed  By 

T 

DSET4 

DS456 

(updated  value) 

Linkage; 

CALL  TSUB 
Subroutines  Used: 

None. 

Local  Variables: 

M„ . 

CON  = 

"'^^23 

M2J  = (integer) 

PIK  = Array  of 


K = Substrata  index 


SUM2 


SUMS 


CONI 


CON2 


CONS 


CON3S 


CON4S 


c^)  a 


S2 


^ M_  ^S2  ON 

3 r ) Cs 

^ M,.*  N=1  “ ^ 


2j 


/^M  - 1 . 

^ S2 

CON4S3  = 2 ( — r — , 

) ( S 

IT  ^ ) 

^0!  = 1 

(X  y 

/-S2 

0 n2 

CON5S2  = 3 f — — ) 

C S 

M_.  - 
2j 

va=i 

a y 

M2JM1  = M_.  - 1 
WA- 

WAKPIK  = --- 

PIK2  = 

PIK3  = 
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KPl  = K.  + 1 
PIKPKP  = TT^  1T^, 

2 2 
TERM2  = 7T^,  + TT^ 

PIKPP  ='7Tj^„ 


Processing: 

1.  Compute 


HWA2K(K) 

HWAS2 


= M„. 
2j 


PIK(K)  = = XM2JS 

for  each  group  II  substrata  in  the  stratum 


WA 


2K 


WA 


2S 


S2  „ • S2  3 

2.  Compute  SUM2  = L and  SUM3  = S 7T 

a=I  “ o:=l  “ 

3.  Compute  coefficients  CONI,  CON2,  CON3,  CON3S,  CON4S, 
CON4S3,  CON5S2 

4.  Compute  for  each  pair  of  distinct  group  II  substrata 

K,  KP  = K'  K 


the  following 

a)  PIKPKP  = PIK(K)  * PIK(KP) 

= ’^K  * \' 

b)  TERM2  = TTj^,  + 


c)  PIKPP  = TTg.,, 

= CONI  * PIKPKP  + CON2  - TERM2 

- CON3S  - PIKPKP 

4 CON3  * [PIK{K}^  PIK(KP)+  PIK(K)  * PIK(KP)^ 
+ PIK(K)^  * PIK(KP)2] 

- CON4S  TERM2  + CON5S2  * PIKPKP 


- CON4S3  * PIKPKP 
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where 

WA’j^  andWA'p^,  are  the  non-epoch  wheat  areas  for 
substrata  K and  K*, 
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SUBROUTINE  CLASSN 
l 

Purpose: 

■ This  routine  controls  the  computation  of  the  class  nuriber  for  each 
substrata  in  SUBHST  file  as  defined  by  STARTR-ENDZ  user  inputs.  The 
SUBHST  file  is  read  a zone  at  a time  for  the  first  prediction  point  and  a 
new  temporary  file  ISUBH2  is  generated  containing  all  necessary  SUBHST 
data.  For  subsequent  prediction  points  the  ISUBH2  file  is  read  instead 
of  SUBHST.  Fpr  all  prediction  points  a strata  table  is  formed  and  then 
this  routine  controls  the  computation  of  the  class  number.  It  then 
updates  the  ISUBH2  file  with  the  class  numbers  for  the  appropriate 
prediction  point.  . 

Input: 

CASFLG  COMMON: 

H,  NRSSH,  LDSl,  IPP,  NCAMSK 
SSHDTA  COMMON: 

All  data  except  CLASS 
CONST  COMMON: 

ENDFIL 

LEMCM  COMMON: 

ENDR,  ENDZ 
IXSUBH  COMMON: 

LIXSSH,  IXSUBH 
FILES  COMMON: 

LSUBH,  ISUBH2,  CAMSF,  OUTP 
DSETl  COMMON: 

MIK  = M2K 
ARGLST'  COMMON: 

NFATAL 

CLSTAB  COMMON: 

IXPT,  IBPT,  lEPT 
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Oatput: 

CL.STAB  COMMON:  ISUBl,  NACQ 

ISTRAT,  ISBSTR,'  NSCNT,  IGROUP,  IDATl,  IDAT2 
SSHDTA  COMMON: 

CLASS,  MXK,  VMULTK 
CASFLG  COMMON: 

NRCAMS 


Linkage: 

CALL  CLASSN 

Subroutines  Used: 

CALL  GROUP 
CALL  SEGTAB 
CALL  DETCLS 
CALLASSCLS  (lOPT) 

lOPT  = 1 - Means  all  substrata  in  a zone  are  class  0 

lOPT  = 2 - Means  all  substrata  in  a zone  are  class  1 

lOPT  = 0 - Means  that  class  numbers  are  to  be  assigned  via 
computation 

Subroutine  RANACF  is  used  to  read/write  file  ISUBH2  as  follows: 

CALL  RANACF  {ISUBH2,  0,  0,  0,  IXSUBH,  LIXSSH,  0) 

- Open  file 

CALL  RANACF  (ISUBH2,  ISUB,  SSHDTA,  LSUBH2,  IXSU  3H,  LIXSSH,  n) 
n = 1 - Read  file 
n = 2 - Write  file 

Local  Variable  Description; 

ISUB  - Count  on  number  of  records  written/read  on  ISUBH2  file 

IFIRST  - First  time  flag,  = 0 - not  first  time 

^ 0 - first  time 

MAXSCT  - Maximum  substrata  that  can  be  handled  in  a zone,  =300 

IBUF(39)  - Array  for  temporary  location  of  SUBHST  or  ISUBH2  when 
in  read  mode 

NORD  - Don't  read  flag  = 0 - read;  4 0 - don't  read 
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Processing; 

See  flowchart  for  details, 

1.  If  NACQ  is  <2,  then  calls  to  SEGTAB  and  DETCI.S  are  not 
made  and  call  ASSCIjS(O)  is  made.  Means  not  enough  acquired 
segments. 

2.  If  NACQ  is  <2.  then  same  as  above  with  a call  ASSCLS(l). 
Means  only  one  class  = 1 can  be  assigned.  Not  enough  X.'s 

to  split. 

3.  The  CAMS  file  must  be  repositioned  back  to  where  it  was  upon 
entry  to  this  routine.  Subroutine  GROUP  controls  the  reading  of 
CAMS. 


CLASSN  Routine  Flowchart 


ENTER 
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Clear  ISUB  to  1 
NORD,  IBUF  arra^ 
SSHDTA  array  to 
zero 


Set  IFIRST  40 
first  time 


Is 

:his  first\ 
\ pred  pt 
\saPP=l]/^ 

tri  T yes 


Clear  DSETl 
array  to  0 


Open  ISUBH2 
file 


Clear  ISUBl, 
(ISTRAT.ISBSTR, 
NSCNT,  IGROUP, 
IDATl,  1DAT2 
arrays),  NACQtoO 


/Is\ 
a rec,  ^ 
to  be  read 
/NORD=0> 


Set 


Read  a record 
from  SpBHST 
into  IBUF 


IFIRST  4 0 


Read  ISUB 
record  from 
ISUBH2  into 
IBUF 


^ Is 
IBUF  (2) 
IBUF 
[REG 
[ZONE 


IBUF(2)^ 

■^IBUF{3) 

4 IREG2— > 
s^ONE2/ 

lYES 


Move  IBUF 
to  SSHDTA 
COM. 


Move  IBUF 
to  SSHDTA 
COM. 


CLtASSN  Routine  Flowchart  (cont'd) 


Call  GROUP 
to  get  MIK 


Add  1 to  ISUB 
and  ISUBl 
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Is 

ISUBl  ^ 
>MAXSCT, 


YES 


Add  1 to 
NFATAL 


Store  ISTRA2  in 
ISTRAT  (ISUBl), 
ISUBS2  in  ISBSTR 
(ISUBl),  MXK  to 
NSCNT  (ISUBl) 
GRPNO  to  IGROUP 


Store  AREAK  in 
IDATl  (ISUBl)  and 
HSTPW  in  IDAT2 
(ISUBl) 


Print 

error 

message 


Print 

termination 

message 


YES 


NFATAL  9^0 


RETURN 


If  IPP  = 1,  write 
(ISUBl)  record  from 
SSHDTA  on  ISUBH2 
file 


^ 80 

Set  NORD  = 1 
(don't  read) 


Compute  NACQ 
from  summing 
NSCNT  array;  1 
to  ISUBl 
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Is  \ 
NACQ  <2 


Call 

YES  ASSCLS(l) 

" ^ to  get  class 

nos. 


^ Is 
NACQ 


YES 


Call  SEGTAB 
to  form  segment 
tables 


^ 

Call 

ASSCLS(2) 
to  get  class 
nos. 


YES 


' Is  J 
> ISUBl 


NO  . Add  1 
^ to  I 


Call  DETCLS 
to  determine 
classes 


Add  1 to  J 


Call  ASSCLS(O) 
to  assign  nos. 
in  IDA  T2  array 


W rite  record  I 
from  SSHDTA  to 
ISUBH2  file 


Compute  IBEG  - start 
re'c  no.  to  update 
ISUBH2  file  from 
(ISUB -ISUBl) 

110 


Move  IDAT2 
(J)  into  class 
(IPP) 


Set  I = IBEG.  J = 1, 

I ^current  record  pos, 
J - count  on  substrata 
within  zone 


Read  record  I 
into  SSHDTA 
array  from 
ISUBH2 


CLiASSN  Routine  Flowchart  (cont'd) 
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SUBROUTE^E  SEGTAB 


Purpose : 

• Given  a set  of  data  for  one  zone  in  a strata  table  set,  this  routine 
computes  a normalized  array  of  standard  deviations,  X^,  sorts  them  in 
ascending  order,  computes  the  gaps  between  the  sorted  X‘s  and  ranks 
them.  This. data  is  output  in  the  segment  tables. 

Input: 

CLSTAB  COMMON: 

NSCNT,  IDATl,  IDAT2,  ISUBl 

* 

Output: 

CLSTAB  COMMON: 

IDATl,  XORD,  IXPT,  IRANK 

Linkage: 

CALL  SEGTAB 
Subroutines  Used: 

CALL  SORTAG  (IRANK,  1,  IPT,  IXPT) 

Local  Variable  Description: 

IPT.-  Number  of  items  in  segment  arrays 
= sum  of  all  NSCNT' s in  zone 

GAP(300)  - Table  of  gap  values  between  sorted  X^  for  each  substrata 

in  a zone  = GAP 

IPT 

SUM  - S T(I) 

■ 1=1  • . 

ICON  - 10^° 

XMIN  - Current  minimum  value  in  gap  array 
XMINS  - Saved  minimum  value  from  gap  array 
IRK  - Current  rank  value  (1-N) 

IMPT  - Subscript  in  GAP  of  current  smallest  value 
Processing:' 


See  flowchart. 


Subroutine  SEGTAB  Flowchart 
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Subroutine  SEGTAB  Flowchart  (cont'd) 
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SUBROUTINE  DETCLS 


Purpose; 

•This  routine  determines  how  the  array  XORD  is  to  be  aroken  down 
into  classes.  It  produces  the  count  of  classes  and  the  beginning  and  ending 
subscript  in  XORD  for  each  class. 

Input : 

CLSTAB  COMMON: 

XORD,  IXPT,  MAXCLS,  IRANK,  NACQ,  IXPT 
CASFLG  COMMON: 

H 

Output: 

CLSTAB  COMMON: 

IBPT,  lEPT  and  ICLNT 

Linkage: 

CALL  DETCLS 
Subroutines  Used: 

CALL  SORTAG  (IDT,  1,  ICLNT,  IDUM) 

Local  Variable  Description; 

CC  ' - Constant  25  minimum  allowed  gap  within  a class  of  X's 

K - Counter  on  number  of  rank  entries 

I “ Counter  within  rank  table 

ID(IO)  - Table  of  class  breakpoints  in  XORD 

IDUM(IO)  - Pointer  into  ID 

LB  - Low  boundary  to  search  for  class  break 
lUB  - Upper  boundary  to  search  for  class  break 
J - Count  on  class  breaks 

Processing; 


See  flowchart. 


DETCLS  Flowchart 
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ICLCNT>0 
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SUBROUTINE  ASSCLS 


Purpose: 

•To  assign  class  numbers  to  all  substrata  defined  by  ISTRAT  and 
ISUBST  in  the  strata  tables. 

Input: 

CLSTAB  COMMON: 

ISTRAT,  ISUBST,  NSCNT,  IGROUP,  IDATl,  IXPT,  IBPT,  lEPT, 
ICECNT,  NACQ,  ISUBl 

Output: 

CLSTAB  COMMON: 

IDAT2 

Linkage : 

CALL  ASSCLS  (lOPT) 
lOPT  is  input  as  follows: 

lOPT  = 0 - Compute  class  numbers- using  the  algorithm 
lOPT  = 1 - Set  all  class  numbers  to  0 
lOPT  = 2 - Set  all  class  numbers  to  1 

Spbroutines  Used: 

None. 

Local  Variable  Description: 

ISTART,  lEND  - Group  of  substrata  with  = strata  ID 

ISTRSV  - Saved  strata  to  see  if  new  strata  occurs 

ICT(IO)  - Count  of  substrata  for -each  class 

IFLAG  - = 0 - No  substrata  within  strata  has  segm. 

0 “ At  least  1 

IFLAGl  - = 0 - not  done,  ^ 0 - last  entry  in  IGROUP  passed 
IJCL  - Glass  number  with  most  substrata 
IMAX  - Largest  substrata  count 

Processing:  - 


See  flowchart, 


Subroutine  ASSCLiS  Flowchart 
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-YES  SUBROUTINE  DESCRIPTIONS 
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SUBROUTINE  YES 


Purpose: 


Given  the  true  yield  for  each  strata,  and  also  an  srror  estimation 
of  the  bias  and  standard  deviation  of  error,  YES  generates  an  estimated 
yield  at  from  1 to  6 estimation  points  in  a simulation  season,  for  the 
strata.  An  option  allows  the  estimated  yields  to  be  the  same  as  the  true 
yields,  bypassing  the  error  simulation.  A printed  report  is  also  optional. 


Input: 

1.  YES  is  passed  these  quantities  by  LEM  through  COMMON 

(see  LEM  COMMON  block  descriptions  for  complete  description  of 
format) : 


a.  COMMON  /LEM CM/ 


TITLE 

ICASE 

startr] 

ENDR  I 
STARTZ  r 
ENDZ 
lYES 


Used  by  PAGER  and  EJECT 
Case  no.  of  output  file 

Start  and  ending  regions  and  zones  to  process 

=0,  1 do  error  simulation  for  estimation  yields 
= 3 bypass  error  simulation 


b.  COMMON  /CNTRL/ 

PRINTF  =0  no  printed  report 
= 1 print  report 

SEED  • SEED{5)  is  used  in  generating  a 3 andom  number 
for  error  simulation 


c. 


COMMON  /FILES/ 


YESOUT 

LYESO 

YESERR 

LYESER 

OUTP 


I/O  device  no's  and  no.  of  words  in  one  record 
for  YES  input  and  output  files 


Used  in  writing  printed  report 


d.  COMMON  /STATS/ 

ITER  Iteration  no.  for  report 
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2.  YES  has  one  input  file,  YESERR,  generated  by  the  SEE 

program.  Each  record'  is  read  into  a COMMON  block.  See 
Section  2.  4 of  the  Users  Manual  for  a description  of  the  input 
file,  and  Programmers  Manual  for  a detailed  description  of 
the  COMMON  block.  ' 


a.  COMMON  /YESIN/ 


COUN 
IREG  . 
IZONE 
ISTRAT 
YTRUE 
IZULU(6) 
BIAS{6) 
SD{6) 


Country 
Region 
Zone- 
Strata 
True  yield 

The  Zulu  date,  bias,  and  standard  deviation  of 
error  for  each  of  up  to  six  prediction  points 


Output: 


1.  YES  passes  these  quantities  back  to  the  calling  program  LEM 
through  COMMON  (see  COMMON  block  descriptions, 

for  complete  description  of  format): 

a.  COMMON  /CNTRL/ 

SEED  SEED(5)  contains  the  seed  for  the  random  no. 

after  the  last  use  of  it 

b.  COMMON  /STATS/ 

NREC  NREC(5)  contains  the  no.  of  records  processed 

from  the  YES  input  file  (excluding  header, 
records  skipped,  trailer) 

NYESR  Contains  the  no.  of  records  writt(>n  onto  the 
YES  output  file  (excluding  header  and  trailer) 

2.  YES  produces  one  output  file,  YESOUT,  for  use  by  the  program 
CAMS.  Each  record  is  written  from  the  COMMON  block.  See 
Section  2.4  of  the  Users  Manual  for  a description  of  the  output 
file,  and  Programmers  Manual  for  a detailed  description  of  the 
COMMON  block. 
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a.  COMMON  /YESOUT/ 

CID  Country 

IREGID  Region 

IZONID  Zone 

ISTRID  Strata 

YSTR  True  yield 

IZPRDD(6)  Zulu  prediction  date 

YSCI(6)  Estimated  yield 

VSYCI(6)  Standard  deviation  of  yield  error 

3.  YES  produces  a printed  report,  on  option.  See  YES  Problem' 
Description,  Figure  2. 

-Linkage: 

CALL  YES  YES  is*  called  by  the  LEM  prograrn. 


Subroutines  Used: 


CALL  BETAD  (SEED{5),  0,  0,  RN,  1,  lER)  to  get  a random 
number  RN  from  a normal  distribution 

CALL  PAGER  (NO)  to  print  line  on  report 

CALL  EJECT  (NO)  to  start  new  page  on  report 

CALL  FZULU  (IZULU(J),  lOUT)  to  convert  Zulu  date 

CALL  ERRMES  (3HYES,  3HYES,  1,  1)  to  process  error  message 


Local  Variable  Description: 


IFILL 

YNAME(2) 

RN 

lER 

ITEMP 

lEND  ' 

INEW 

ER 


0 fill  for  header  and  trailer  records 
Output  file  name  3HYES 
Random  number 

Error  flag  from  BETAD  (always  0) 

No.  of  0 fill  words  to  put  in  record 

Flag  for  end  zone 

=0  haven't  reached  end  zone  yet 

= 1 found  end  zone 

Count  of  no.  of  strata  per  report  page  = 3 max. 

Used  to  compute  % error;  =0  unless  true  yield  = 0, 
then  = 10"^ 
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Processing: 

See  flow  diagram  for  a flowchart  of  YES.  The  two  equations  used 

are: 


YSCI  = YSTR  + BIAS(J) 

-1-  RN  >!=  SD{J) 

where.. ...YSCI 

- 

yield  estim'ate  for  J prediction  point 

BLAS(J) 

til 

bias  error  for  J prediction  point  for 
strata 

YSTR 

- 

true  yield  of  strata 

RN 

= 

random  nuniber  from  a normal 
distribution 

SD(J) 

- 

til 

standard  deviation  of  error  at  J point 

J 

= 

integer,  range  1-6 

Special  case: 

If  YSCI  <0,  YSCI  = 0.  0 


b,  PERCNT  =((ABS  (YSCI  - YSTR))  * 100)/(YSTR  + ER) 

where  PERCNT  = percent  of  error,  always  positive 

YSCI  = yield  estimate 

YSTR  = true  yield 

ER  = 0.  0 unless  YSTR  = 0,  then  ER  = lO"^  to 

take  care  of  this  special  case 


YES  FLOW  DIAGRAM 
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^ EHTER  ^ 
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YES  FLOW  DIAGRAM  (CONT’D) 
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PART  V 

SUBROUTINE  LISTINGS 


P EL^ALRA«A»lf760fl30t  5&102 


« I 


000001 

000002 

c 

000003 

c 

000000 

c 

000005 

c 

000006 

c 

000007 

c 

000008 

'000009 

ooooto 

000011 

000012 

000013 

000014 

' 

000015 

000016 

000017 

. 

0000  18 

000019 

000020 

000021 

000022 

000023 

000024 

00002b 

000026 

000027 

000028 

000029 

20 

000030 

000051 

26 

000032 

27 

000033 

28 

00OO34 
OOOU  5b 

• 

000036 

000037 

36 

000058 

0000  59 
0OOO40 
000001 

4 0 

000042 

000043 

000044 

t 

OO(i04b 

60 

000046 

0000«7 

000048 

65 

0OO049 

OOOllSO 

OOOObl 

OOOOS2 

SUB«L'UrINF  ALCAMACX»GaHMA»  lEK) 

calculatfs  the  uamha  Function 


X lupiir 
GAMMA  nuTPUr 
iFH  tRPOP  FLAG 


60  IF  X NO!  IN  RANGE  0.  TO  68. 


DTUFHSiON  OnZ-OfCOO 
OOUUl.fc  PPLCISION  iifC,F,G,HLNPJtrtZ 

DATA  fv-J.o^oioosKiPGn-^tS.Tvfii/TeBoojflSD-St-i FSiiaTntsao-flt  aigama 

F3  - /SiAS<'‘j?6630/D-'lf8.3Fb6«66Eil?bl  / !)-«  t ? , Oo  ! 09 1 PSO^?b5i)r)-3 1 AlGAMA 

836qh^S2037^8<'U-3i  1 , U «'/ 7 1 '< 53b7 78  9D-? i -2 . 66 1 fio'iVyO'jiOon-O  t Al  GAMA 

* 7. 900070-2 1 8. 1 9 70926120  15bbO~2tO.  118^03301667610-1  j At  GAMA 

*0-.2278/|339in233Si>-l  .9.999999999999900-1/ 
data  C/-1.917'v.>69r/'i?69?l)-3»6.0tVSOflOI  7 50 60 FO-0 » -S . 98238 09b23«09SD Al  GAHA 
♦-0,7. 93080 7956807909-0,. 2. 77 77 77 77 77 77780-3 .8.333333333 533330-2/  ALgAmA 
UA  tA  I /.918938b  532006  73/ 

GAMMA=o. 

H K=60 

IF  fX  .IE.  0.0  .OR,  X .Gl.  88.0)  RETURN 
IF.R  = 0 

ysx 

IFCY.Gg . ro.)  GO  1 9 60 

Z=0'uin{Y,  1 ,0) 

IFC/.Mt .0.0)  no  TO  20 
2=1.0 
G=2,U 
GO  TO  ?7 
G = lifl) 

1)9  26  j=2,l« 

0=G^2+h(J) 
ir(Y-3.0)  26, Ob, 38 
If-  (Y.G7.2.0)  Gu  TO  05 
G = G/Y 

Ir(Y.U.i.O)  G=G/(Y  + i.'0'). 

GO  TO 
F = 1.0 

K=0INr(Y-7+,S)-2  . • 

DO  00  j=l,K 
Y=Y-1.0 

F=F5Y 
G = G + F 

05  GAHNA  = DlOr,(G) 

RKIORM 
2 = Y»Y 
G=C(1) 

DO  65  J=2,6  • , 

G=G/2+cfO)  ■ 

G=((G/y  + H|  NPI)  + ((V-.5)’Pnl.0G(Y)-y)) 

,GAHUA=r; 

KrlURM 
EMO 


' *NEW 

♦ NEK 

♦ NEK 

♦ NEW 

♦ NEW 

♦ Nl  W 

♦ NEW 

♦ ♦-7 
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000001 
000002 
000005 
000000 
000  0 Ob 
000006 
000007 
OOOOOtf 
000009 

0000  I 0 

00001  1 
00001  2 
OOOOl  5 
OOOOl 't 
00001b 
000016 
000017 
OOOOIO 
001)019 
000020 
000021 
000022 
000023 
000024 
00002b 
000026 
00002/ 
000020 
000029 
000030 
000031 
000032 
000033  - 
000034 
000o3b 
000036 
00003/ 
000036 
0001130 
000040 
000041 
000042 
000043 
000044 
00004b 
00OO46 
000047 
000046 
000049 
OOOObO 
OOOObl 
000032 
OOOObi 
0000'>4 
OOOObb 
OOOOS6 
000()'>7 
OOltObU 


LT  APHDRtl,7604R7t 


390b! 


SUBRUUtTNF  APHDR  ’ APHDR 

C . ■ FILf  BFFINiriONS  AND.  REC'PRD  LENGTHS  FILFS 

COMMON  /FltER  / FILFS 

1 StCiD  ,LSti;il>»CHOHw  ,LCROPW,SUBHST  tLSUBH  » ACfMJT S t L ACO  FILFS 

. 2 tCAHSf  tLCAHSFtCAHERR,LCAHtRjCASF  tLCASF  t YtSOtJT  i LTESO  ' ULTS 

5 fSIChXT  ,LSir.EX*YtSERR*LVL,SER*SEGlRU,LStGTRf  FASoISil  CASD  HLFS 

4 ,TNH  rOUTP  fTACO  ,LTACU  tC ASDSI- f LFASDS  HLFS 

integer  SLGl'O  tCROFH  t SUHhS  1 1 ACuU  I S i f AMSF  ,CAHtRRtCASF  tYESOUT  FILFS 

1 ,SIGF xT?YCSFHRt6EGTHU,rAS0lSt0UTP  .TACU  iCASDSF  FILES 

. C_  • F Ilfs 

C'  " PACL  EJECT  CONTROL  PARAMETERS  FOR  LtM  PAOFCM 

COHHON  /PaOECH/  ■ . PAGECH 

1 NPAgF  tNI  I9L  *HX1  InE,NSTTL  fSUBTTL(lO)  PAl.FCM 

C F-AGFCM 

C lEU  rONTKoL  CARD  INPUT  DATA  . LFMCh" 

COHHON  /lkHC'1  / • LFHCM 

1 TITlF(IO)  tlCASp  tCUNTRYrNTRIALfRSTART»IPRINT,STARTRtSTARTZ  LFmCM 

2 »FNDR  , ,EMD7  tISTG  iICAMS  tlYES  flACQ  » I CL  ASS , I SL X T tISCL  LINCM 

3 flCASJ  *ICaK3  »IPRCAlT,IPKYF.5f,IPRCAStICSFSn,ICSECM,ICSFSHTlL,4ECL  LFmCM 

4 t ICSEYMi  irsESF  T IC.SEACtRStED!  » 9SEE02 1 RSEED3 » RSEE04  ,rtSEEDS  » RSFLD6  LFhCM 

b tPSf  £D/.I(;sfST»  ILSECOflCSEYSfTCStCO.  ICSECO  LFMCH 

DlNFNSlflK  PSEtD(7)  LFMCM 

OnUHLF  P«F.CISIiJN  RSEFD  t RSEED 1 t R SEED2  f RSEE03  t RSEE D 4 , 2SE E Db  LFHCk 

1 tPSF F D6 » RSLE N7  . LFMCH 

EOUrVALtNCE  C RSEEOfRSFEDl  ) LFNCm 

INTFGFR  RSTART fSTARTRfSTAKTZfEMDR  fFNDZ  LFMCM 


C LFMCM 

C flags  and  CilKNTLRS  FoR  CAS  SIMULATOR  LASFlG 

COMMON  /CAFF  LG/  C ASF  LG 

1 H »PPrU>  >N|1W  ,II3W  jHINDOr,IPD  *IPP  fPPOATEfNREGS  LASFLG 

2 »MZToT  TNSTRATtNYFSSK,NSSHSK,NCAHSKiNI?YES  tNRSSH  ,NRCAMS  CASFlG 

3 »ENDC  ,EM|)RLC.rNDZ()N,  IRSTR  , IRZUHE . IRREG  CAsFLG 

4 slUSl  ?LOS4  ,LDS/  ,L0SH  tLDS9  ,LDS10  tLDSII  »LDS12  *LDS13  CASFlG 

•5  »LDS14  ,LDS(b  ,LDS16  ,LDSW  * LRCUUN,  LRRFG  tl  «70NE»LRSTR  CASR  G 

INTFGFR  PPFlG  t WIMOOW  , PPDAIF.  CASF'iG 

C CASPLG 

C statistical  INFOHMaTiUN  for  LEH  ' STATS 

COMMON  /STATS  / STATS 

I  ITFR  ,NStGT4T.4CAMSR,NYESR  t NKEC  ( 7 ) t NC ASCN f NC ASDR  v.  STATS 

EOUTVAlKNCE  ( •'TflTtR  ) STaTS 

C . STATS 

C CAS  CONTROL  CARD  ImPuT  DATA  AND  CONSTANTS  • CASCM 

COMMON  /CASCM  / CA&CH 

1 ARFaCFiYCE  tPHOCF  t APRIJTS  ( 4 , 2)  t PPRU  t S ( 3 , 2)  ,YPRUTS(3»2)  CASCM 

2 t ARFAPbf  S2tiAX  tNFiISTY,HFt  iTOPT  t AUN  IT  S f D IS  I F F .B4  1 ND  ( 4)  CASCM 

3 »WPRiniU4)  ,Af>R£p  ,IPRn(3,14)  tNPDATFjPR0ATE(141  ' CASCM 

INTFGLR  HHi  TuPTt  A0NlT6fDlSTFF»()MlND*KpHinK,APRFP*PRDATE  CASCFf 

C CASCM 

CALL  (JiCT(14)  Al’HDK 

HRITF  COUTPiIOOO)  APhDR 

1000  F0RMAT(/23X»7?HA  REa  AND  PRODUCTION  SUMM  APhDR 
lA  R Y REPORT//)  AF'HDR 

IF(PPF|  G.l  0,0)  WRnF(nOTPt2000)  CUnTHY  1 1 HR  » NT  APllim 

?000  FORMAT  (2X,  /llcOUN1i!Y»2XtA6»  /X , 9NII10H  t NDUW  rbX  1 11  » 1 bX  » OUT  TF;RA  HUN  » ARMOR 

1 IX. 13/)  ARMOR 

IFIPPFlG.FO. n KRITF(nUTPTiOOO)  CUNTRY,  armor 

1 IPPNI2.1P0)  t IPRDMf  Il’O)  tlF’RDf  1 tlPO)  >NT  AOHOu 

3000  FORMAI  (2X, /HC0U.NTRYii2X»A6f  7X,  IbnF’RLDlLnoM  CATE  >2X»  APllOR 


28234-6029-RU-00 
Page  362 


0000*59 

000060 

000061 

oooooa 

00006i 
00006** 
000065 
000066 
000067 
000068 
000069 
000070 
0 0 0 0 7 1 
000072 
000073 
000070 
000075 
000076 
0UOO77 
000078 
000079 
000080 
oooom 
000082 
000083 
000089 


"1  2(12,  l»/>  tl2f ‘5Xt9tllTt(?ATlON  »tXrI3/)  APHOR 

W(?1TL(OUIP,/IOOO)  ' APHRk 

9000  F0Kf1Ar{15XTlH*t26)(t8HA  R F A , 25X  i 1 H A » 6X 1 1 OHY  1 E L D rSXt  APHDR 

1 lH7.6yf?0HP  ROilUCTION  ) APunR 

lMI)X  = AuHn3M  APHOK 

WlUTL(tjUlP,^0O0)  (AI’KUrs(l?lNt5X)  tl=l  f'O?  APHOR 

I (YI>Hinsn,IIJ!)X),l  = tf-5)»(PPf<UTS.(ltlNl)X)»I  = l*5)  APHDR 

50  00  FORiiAK  15Xfli|Y.P0X,9A6»t5X,  In*  » ?X  t 3 A6  f 1 X , I H»  t 3X  f 5A6/ 1 5X  1 1 H»  f 59X  t APfiDH 
1 IH+tgU,!)!*)  ■ APHDR 

hf?ITt.(0"Tf’i6000)  APHDR 

6000  PORMAT(?Xf IHKiSX, )HZi8X,lH»f23Xt6HN0,  1 N , 1 OX . 3HH0 , i 3X r APHDR 

1 7HCV  APEA,?Xt2HCVt3X,ll|A»19Xt8HST  OLV  »tl8X»6Hrv  PRD»5X»2HCV)  APriDR 
WRl  T>.  (uIMPt  /OOO)  • APHDR 

7000  FDKHA1 (?X,lHt»3Xf I HO , AX , IH^ t 2X n 9HT RUF f 5X « 9HtS T . , 7X » APHDR 

1 VHbHbSTPATAtbXf  ttH6FGMi.MTS?PXt9HfcST.t5Xt5HtPKn,u,lXttH#r1Xt  APHDR 

I 9MTI<'Ut  r3X»flHE,ST.»9X,6!iPCI.  * * ?X  t 9H  1 PUF  1 5X  tOHbS  T , i OX  ? 9HLS  T . » 3X  t APHDR 
1 'iHFFH'l/R)  APHDR 

wF!iFtroinp»flooo5  ' aphi)F( 

8000  FDR*-iAT(2X,lFlG»3X,!FiH»lX,8H5rHATA  »,  3X  f 2HW  A , 7X  i 2HH  A t 1 0 X » 5HF, ROUP  t APHDR 

1 ;x,«HoF  CROUP. PXtOMPrT. f3X»9HPCT. »2X. IHt, 2C5HYU.I  U,2X)  , APFIDR 

J 6F{  FF*R0Rf2H  ♦.2X.9HPrn)D.5x.9HPRUD,9X.2(4HPCT.,3xn  APHDR 

WRI-Tt  UiinPjOOOO)  APHDR 

9000  FORHAI  (6X,lHi-  , «X  . 1 H*  » ? 1 X l 1 H 1 1 0 X . 1 H2  . OX » 1 M 3 . 5X  , 1 FU  . 9X  i 1 HP  t 3X  t OHTRUF  At>HD|< 
J .3X.4|HJF*UE.2XttH-7t2lX.lM«'.19X.2(0HlRUt"f  5X)/)  ' APFIDR 

RFUIKH  ' APHDR 

EDO  ■ APFIDR 
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I-UR»IS  ASSCLS 

SUBROUTINE  ASSCLS nnPT)  ASSCLS 

C assigns  class  numbers  to' all  SUBSTRATA  IN  THE  STRATA  TABLES  ASSCLS 

C TABLES  MECCESSARY  TO  nEFERMINE  CLASS  SETS  WITHIN  A ZONE  CLSTAB 

CUMMON  /CLSTAB/  . CLSTAB 

1 I STRATI  300 ) , I SBSTRI 30  0) tNSCNT (300 ) » IGRGUP ( 300 ) , I DAT II  300) , MODI 

2 IDAT2(300> ,XnRD( 300 ) , IXPT I 300)  , I RANK! 300) , IBPTI 10 ) , lEPTI 10) ,M0D1 

3 MAXCLS» ICLCNT, ISUBlrNACO  CLSTAB 

DIMENSION  DATl(300)tDAT2(300) ,RANK(300)  MODI 

6 OU I VALENCE  I IDATl I 1 ) tDATlI 1 ) ) » I IDAT2 I 1) » DAT  2 I 1 ) ) » I I RANK  I 1 ) , CLSTAB 

IRANK I 1 ) > . CLST AR 

DIMENSION-  ICTI 10)  ASSCLS 

DATA  I DAT/-1000000/  ASSCLS 

DO  5 I = l t ISUBl  ASSCLS 

IDAT2  I I ) = 0 ' ASSCLS 

5 CONTINUE  . 'ASSCLS  . 

IFIIOPT  - 1)23,20,10  ASSCLS 

10  DU  15  1=1, ISUBl  ASSCLS 

IDAT2(I)  =1  ■ • ASSCLS 

15  CUNTIIMUE  ASSCLS 

20. RETURN  ASSCLS. 

25  DIJ-50  1=1,  ISUBl  ASSCLS 

lElNSCMTiI)  .EO,  0)G0  TO  50  ASSCLS 

IPTR  = IDATl I I ) ASSCLS 

DU  30  J=1,MAC0  ' ASSCLS 

JPT  = J ASSCLS 

IFIIPTK  .EG.  IXPT(J))GO  TO  35  ASSCLS 

30  CONTINUE  ' ASSCLS 

GO  TU  50  ASSCLS 

35  DO  40  J=1,ICLCNT  ASSCLS 

JCLS  = J ASSCLS 

IFIJPT  .GE.  IBPTIJ)  .AND.,  JPT  .LE.  IEPT(J))GO  TO  45  ASSCLS 

40  CONTINUE  I ' ASSCLS 

GU  TU  50  ASSCLS 

45  ll)AT2(I)  = JCLS  ASSCLS 

50  CONTINUE  ASSCLS 

C ASSIGN.  CLASS  NUMBERS  TO  GROUP  2 SUBSTRATA  WITH  NO  SEGMENTS  ASSCLS  ' 

' ISTRSV  = ISTRATIl)  ASSCLS 

1=1  ■ ASSCLS 

IFLAGl  = 0 ASSCLS 

55  IFLAG  = 0 ASSCLS 
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ISTAKT  = I 
DC)  60  J=1»ICLCNT 
ICT(  J ) = 0 
60  CGNiTINUe 
65'  lEND  = I 

IF(IGRGUP(I)  .NE.  2 .OR.  MSCNT ( I ) 
IFLAG  = 1 
IP  = IDAT2( I ) 

ICT( IP)=ICT(IP)+1 
70  I = I + 1 

IF( I .LE.  I SUB  1 ) GO  TO  7 5 
IFLAGI  = 1 
bU  TU  80 

75  IF{ISTKAT(I)  .EO.  ISTKSV)GO  TO  65 
ISTKSV  = ISTKAK  I ) 

80  IF{IFLAG  .ME.  0)G0  TO  85 
IF( IFLAGI  ,NE.  0 ) GO  TO  20 
GO  TO  55 
85  IMAX  = IDAT 

DU  90  J=1,ICLCNT  • 

IF(  ICT ( J)  .LE.  IMAX)G0  TO  90 
IMAX  = ICT ( J ) 

IJCL  = J 
90'  CONTINUE 

DO  95  J=ISTAKTt lEND 
IF(IGROUP(J)  .EO.  2 .AMD.  IDAT2(J) 
95  CONTINUE 

IF( IFLAGI  .ME.  0)G0  TO  20 

GO  TO  55 

END 


ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

,EQ.  OIGO  TO  70  ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

.EO.  0)IDAT2(J)  = IJCL  ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 

ASSCLS 
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P cL^^ETADTt',7<30i(?7t  ?9l09  t J 


000001 

SMUHOUTTHf;  BETAO(SEED,XBAR,SIGMAf  Xlf  lOPT.  lEK) 

000002. 

DOUHLF  PHFCISION  SEED 

00000  < 

• IMTFOFr  Ft  AO 

flooono 

HI-AL  K 

OOOOOS 

' ' 1 » 

DA)  A l.’/l'O./ 

OOOOOO 

DATA  K/?./ 

000007 

DATA  F-p/. 00003/ 

oonooo 

DATA  <10  /l.F-6  /■ 

000009 

30  CONTHJUf- 

OOOOlO 

,,  HAC.SO 

0000  1 1 

1=0  ' 

0000)2 

XAvf.  = X|jAR 

POOO  1 .i 

xr=().o 

OOOOl 9 

• 

IFK  = 0 

0000  1‘J 

. ' c 

1 1 ■ 

OOOOlO 

: C 

CHOOSk  DM J FORM  RANDUM  NUmBfR 

00001/ 

CAU  Pt)HlA(SEFO*H> 

000016 

c 

. 

000019  - 

■ . . c 

COMPUTE  T,r.HK,HW,  » N0HKA|  dISTRIU.  PARAMETERS 

000020 

' • t 

‘ T = SI)RT(ALriG(l  .0/(PM’))) 

0000?! 

1 

ir-(P.GT.0.bH=St3«T(AknG(1.0/(  (l.O-POtd.O-P)))) 

00O022 

CllK  = T-(?.307b3+,2706i’»n/(  1.0  + 0.99229«T  + ,04  961*T*T) 

OUOOP3 

H’'J=niK 

oooo?'t 

JF(I>.1  F.O.b)  RN  = -RN 

00002b 

c 

000020 

c 

IF  ndri'ai  nisTPiu,  optiont  jump  out 

000027 

IK(T>IP)  ,L(1,0)  on  TO  7o 

000026 

Xl=RN 

000029 

Kf  TURN 

OOOO'IO 

70  CDNTIIJUF 

000031 

C 

000032 

c 

CHECK  FOP  FNO  CASt.S 

000033 

, 

IP (xhar.lt.o,  ,nn.xGAR,r,T.i.)  UR=1 

000030 

lF(Sl(;tiA«t.  T.0.0)  rF.R  = ? 

OOOO  5b 

IF  (X6/.P. OT. 0.0, AND. XnAR.LT. 1.0. AND, SIGMA, OT, 0,0)  GO 

000030 

X 1 = XI)AR 

000037 

iKxyAn,i.T,o,)  xi=o.o 

000036 

IF(X<jAR.(JT,!  .)*  Xl  = l. 

OOOo  59 

Hi  TURN 

oono/io 

c 

OOOOOl 

c 

SNITCH  If  average' AHOVt  HALF 

000002 

10  COUTlMijr 

000003 

IF  (aRaP.IE,0,3)  GO  TO  20 

000009 

FLAG=1 

00009b 

XAVr.sl  .0-X6AR 

0 0 0 0 9 6 

c 

00009  / 

c 

COHPUrP  lipPtR  IIMJT  OH  SiGMA 

000096 

20  COMTKniF 

00(1099 

SIbMAt  zXAVCA'SOKTC  { dOO-XAVG)/(XAVG+FP)) 

0000‘''0 

SIG=SJoMA 

OOOOSl 

JF(3lr.MA.t  t .STCMAU  go  to  30 

000(1'. 2 

STGsSIgMAI. 

0000‘53 

IPK  = 2 

000034 

c 

00003b 

c 

, COMPUTF  Till  METHOD  THKFSHHnLO 

000036 

5 0 COKTUtuP 

00()0'^/ 

5li;T  = XAV(;TSnRT(n.0-XAVn)/<XAV0  + )O) 

nuoo'iU 

c 

' 
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0000'i9 

OOOOAO 

OOOOAl 

000062 

000063 

000060 

000065 

000066 

000067 

000060 

00006V 

000070 

000071 

000072 

000073 

000074 

000075 

000076 

0000/7 

00O07S5 

000070 

OO00«0 

OOOOBJ 

000062 

OOOOP3 

OOOOP4 

OOOOfli 

000066 

000067 

.000066 

00006V 

ooooo'o 
oooovi 
000002 
000003 
no  0004 
000(105 
000096 
000007 
OOOOOti 
000090 
000100 
000  in  1 
000102 
000105 
000104 
000105 
non  106 
000107 
nooiOH 
nooiov 
noo  1 1 0 
0 (1 0 n 1 

000  I 1 2 

0005 ) 5 
000114 
000115 
000116 
00011 7 

nuo  11 11 


C COMPUTE  bFTa  PA'UMtTERS  A AND  iJ 
XStJrXAvr.^XAVG 
SIGSO=sIG*SIG 

A=(X6O-XAVG^:(XSa  + SIGS0)l/SIGS0 
B=((l.O-XAvro/XAVC)+A 
ir(.4IG.GI.StGT)  GO  TO  40 

c 

C approximation  HtThOO 
C 

c 

c COMPUIK  li[7A  approximation  PARAMETERS 
YP=-RN 

H=2-0/  (1.0/(2.0*A-  l.O)  + 1.0/(2.0*b  - l.O)) 

Y=(YP»YP-5.0)/6.0 

H=(YP«S0RT(H+Y))/ 

1 H-  (1. 0/(2. O + B-UOl-l  .0/(2. 0*A-1.0n»<Y  + 5. 0/6,0-?, 0/(5. 0*H)J 

C 

C COMPUTT  Xl 

16  CAU5(AL0G(B)tP,’rt).r,I.  67,0)  GO  TO  50 
XI  = A/(A  + I3#EXP(2.0<'W)) 

GO  TO  60 
C 

C nEHAIJVfc-  HtTHOU 
C 

C'RFCOKPUTE  A AND  B IF  OVER  LIMIT 
40  CONTINuF 
CHK=AtO 

IKCMK.lt. R)  GO  TO  BO 

lJP=(0/C>-R)t(R~J .) 

A=(I'P/H)»A 
ll  = bP 

BO  CONTINUf 
1 = 0 

PR1=1, 

PI  0 = 0. 

XH1=1. 

Xt  0 = 0. 

XT=XAV(; 

1?0  I=lTl 

ir(I,GT.55)  GO  TO  100 
CALI.  lurTAKXltA.BtPO.lER) 

IF ( ItH.GT.O)  GO  TO  100  , . 

Otpr=ABS(PO-P) 

UIPF1=aNIH1  (aBSCXI-XLO)  ,ARS(XI-XHn) 

If (OIFp  .LF.EP.OR.DfPF 1 .L I .SG  ) GO  TO  60 
C 

C CHECK  IP  f)ONF>  WITHIN  TO!  tPANCE 
IFCPO.Lf .P)  GO  TO  105. 

XHI=Xt 
PHlsPO 
(;0  TO  106 

105  rnuTliHiP 
Xl 0=X1 
PI  0 = P0' 

106  continue 

XI=(XHI+X1 0)/2, 

1.0  ID  i?0 

c error  Rf  TUkN 

100  CONliruF 
II  l!=5 
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0001  19 
OOOlPO 
0001?1 
■oooi?a. 

OOOlPi 
000  l£ii 


XI =0,0 
KfTliRM 

60  continue 

IFCrbAG.EO.n  XI=1, 
KFIUKN  , 

END 


- XI 
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on  -oo  noon 


FOR T IS  BLKDTA 

BLOCK  DATA  BLKDTA 

BLrjCK  DATA  ROUTINE  FOR  THE  LEM  PROGRAM  BLKDTA 

BLKDTA 

COMMON  BLOCK  DEFINITIONS  , BLKDTA 

ARGUMENT  LIST  FOR  ERROR  PROCESSING'  ARGLST 

COMMON  /ARGLST/  ARGLST 

1  NERRS  ,NFATAL ,NPFRRStNARG  tARGIIO)  ' ARGLST 

DIMENSION  lARGIlO)  ARGLST 

EOUIVALEMCE  ( IARGjARG  ) ARGLST 

ARGLST 

CAS  control  CARD  INPUT  DATA  AND  CONSTANTS  CASCM 

COMMON  /CASCM  / . CASCM 

1 AREACFtYCF  ,PRDCF  ,APRIJTS(4»2)  »PPRUTS(5,2)  ,YPRUTS(3t2)  CASCM 

2 , AREAPS,S2MAX-  ,NHISTY,HH  ,TOPT  » AON  I TS , 0 1 STF F , BW IND ( 4 ) CASCM 

3 ,WPkI0K(4)  tAPREP  ,IPRD(3tl4)  t NPDATE , PRDATE ( 14 ) CASCM 

INTEGER  HH»  TOPT,  AI.JN  I T S » D I ST  F F , 6W  IND  t W P R I OR  , APR  EP  , PR  DATE  CASCM 

CASCM 

FLAGS  AND  COUNTERS  FOR  CAS  SIMULATOR  CASFLG 

COMMON  /CASFLG/  CASFLG 

1 H 'tPPFLG  ,NBW  ,IBW  ,WlNOnWtIPD  ,IPP  ,PPDATErNREGS  CASFLG 

2 tMZTOT  ,NSTRAT ,NYESSK»NSSHSK, MCAMSK, NRYES  ,NRSSH  ,NRCAMS  CASFLG 

3 tENDC  ,ENDREG,ENDZnN» IRSTR  , I R ZONE » I RR EG  CASFLG 

4 jLDSl  »LDS4  tLDS7  ,LDS8  »LDS9  ,LDSLO  ,LDS11  tLDSlZ  ,LDS13'  CASFLG 

5 ,LD514  tLDS15  »LDSL6  ,LDS17  , LRCO UN , LRR EG  , LR Z ONE r LR STR  ' CASFLG 

INTEGER  PPFLG  ^ WINDOW  t PPDATE  CASFLG 

C CASFLG 

C CONSTANT  QUANTITIES  FOR  LEM  PROGRAM  CONST 

. COMMON  /CONST  / ' CONST 

1 NTRMX  ,MAXR  ,MAXZ  , I MXSEG, ENDF I L , I TSF G CONST 

C CONST 

C file  DEFINITIONS  AND  RECORD  LENGTHS  F ' F s 

COMMON  /FILES  / FILES 

1 SEGID  ,LSEGlD,CPnPW  ,LCROPW» SUBHST, LSUHH  , ACQUIS, LACQ  FILES 

2 ,CAMSF  ,LCAMSF,CAMERK,LCAMER ,CASF  tLCASF  ,YES0UT tLYESO  files 

3 ,sigext,lsigex ,yesfrr,lyeser, segtru,lsegtr,casdis,lcasd  files 

4 ,INP  ,UUTP  tTACO  ,LTACO  ,C ASDSF ,LCASDS  . FILES 

INTEGER  SEGID  ,CROPW  SUBHST  , ACOO  I S , CAMSF  ,CAMERR,CASF  ,YES0UT  FILES 

1 ,siGEXT , yesekr,segtku,casdis,gutp  ,taco  ,casdsf  files 

c . files 

C INDEX  RECORD  FOR  CAS  CUMULATIVE  FILE  (CASF)  IXCASF 


28234-_6029-RU-51 
Page  367  ■ 


nooon  oo  o<~>  r>  n r>  r>  oo 


COMMON  /IXCASF/  IXCASF 

1 IXCASF( 1 ) tL IXCAS 

IXCASF 

INDEX  RECORD  FOR  CAS  DISTRIBUTION  FILE  IXDISF 

COMMON  /IXDISF/  - IXDISF 

1 IXD1SF(  DtLIXDIS 

NOTE...  506  ONLY  ALLOWS  UP  TO  8 PREDICTION  POINTS  INCLUDING  IXDISF 
BinwiMDOWS  ( 506  = 1 + 1 + 8-‘63t  INDEX  + HEADER  + 8 PRED.  PTS.)IXDISF 

IXDISF 

CUMMUN/FILESI/  filfsi 

1 ISUBH2 ,LSUBH2 tMXCLSS  FILESl 

INDEX  RECORD  FOR  INTERMEDIATE  SUBSTRATA  HISTORICAL  DATA  FILE  IXSUBH 

COMMON  /IXSUBH/  IXSUBH 

1 L IXSSH, IXSUBH ( 1 ) • MODI 

IXSUBH 

PAGE  EJECT  CONTROL  PARAMETERS  FOR  LEM  PAGECM 

COMMON  • /PAGECM/  • PAGECM 

1 NPAGE  ,NLIME  , MXL I NE » NSTTL  ,SUBTTL(10)  'PAGECM 

PAGECM 

STATISTICAL  INFORMATION  FOR  LEM  • STATS 

COMMON  /STATS  / STATS 

1 ITER  tNsegtRtNCAmsr,nyesr  t mrec ( 7 ) , ncascr , ncasdr  stats 

EQUIVALENCE  ( NT t ITER  ) STATS 

' stats 

BLKDTA 


« klU 

S rjS  r|^  p^k  ^jk  rgk  ^|k  ^|k  ^|k  ^k  ^|k  ^k  ^jk  «*|k  0fS  ^k  ^|k  ^gk  ^jk  ^k  ^|k  ^k  ^gk  ^k  #|k  ^gk  Jgk  ^gk  ^gk  r^k 


BLKDTA 

BLKDTA 

BLKDTA 


DATA 

NERRS  , 

nfatal,nperrs,marg 

BLKDTA 

C 

1 / 

0 , 

0 T 0,0/ 

BLKDTA 

BLKDTA 

DATA 

1 

A PRUTS 

/ 6HITEN  T ,6HH0USAN ,6HD  ACRE,2HS) 
,6H( IHOUS ,6HAND  HE , 6HCTARES , IH ) / 

■BLKDTA 

BLKDTA 

DATA 

1 

PPRUTS 

/ 6H  n-IUMDR,'6HED  TH0,6HUSAND  , 6H  BUSH  EL  , 2HS  ) 
,6H ( THOUS ,6HAND  ME?6HTR1C  T,6H0NS)  ,1H  / 

BLKDTA 

BLKDTA 

c 

DATA 

1 

Y PRUTS 

/ 6H  {BUSH,6HELS/AC,3HR£) 
,6H(QUINT ,6HALS/HE,6HCTARE  ) / 

BLKDTA 

BLKDTA 

BLKDTA 

c 

DATA 

AREAPS 

/ 10289.712  / 

BLKDTA 

BLKDTA 

DATA 

ENDFIL, 

NTRMX  ,MAXR  ,MAXZ  ,IMXSEG 

BLKDTA 
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C 

C 


C 

c 

c 


1 

/ 

4HZZZZ,  100 

. 999  T 999 

,15  0 / 

DATA 

MXCLSS 

/ 10 

/ ■ • 

' DATA 

SEGID  ,LSEGID 

tCROPW  »LCROPW 

tSUBHST, 

LSUBH  .ACOUIStLACO 

1 

/ 

1 

t 17 

,2  ,33 

, • 3 , 

168  , 

12  , 107  . 

DATA 

CAMSF  tLCAMSF 

,CAMERR,LCAMER 

,CASF  ♦ 

LCASF  ,YESnUT ,LYESQ 

1 

/ 

7 

. 19 

, a , 50 

, 14 

504  , 

10  , 23 

DATA 

sigext,lsigex 

, YESERRjLYESER 

jSEGTRUt 

LSEGTR,CASDIS,LCASD 

1 

/ 

9 

T 5 9 

, 11  , 23 

, 13  , 

16  , 

4 ■,  303 

DATA 

INP 

,OUTP 

,TAC(0  ,LTACQ 

tCASDSF  , 

LCASDS. 

1 

/ 

5 

» 6 

,16  ,129 

, 15  , 

81  / 

DATA 

ISUBH2 .LSUBH2 

1 

/ 

17 

T 39 

/ 

DATA 

MXLIME 

/ 40 

/ 

DATA 

ITER 

tNSEGTR 

,ncamsr,nyesr 

, NCASCR, 

WCASDR 

1 

/ 

0 

t 0 

, 0 , • 0 

, 0 , 

0 / 

DATA 

LIXCAStLIXDI S 

1 / 3B8  » 506  / 

TEMPORARILY  LiXDlS  =;  506  ALLOWING  UP  TO  8 PREDICTION  POINTS. 
DATA  LIXSSH  /3200  / 

TEMPORARILY  LIXSSH  = 200  ALLOWING  UP  TO  200  SUBSTRATA  PER 
COUNTRY 

DATA  LDSl  , LDS4  , LOST  » LDS8  , LDS9  , LDSIO,  LOSllr  LDS12 

1 • / 12  . 24  t 81  , 10  , 9 , 20  , 19  , 19  / 

DATA  L0S13f  LDS14,  LDS15,  LDS16,  LDS17 
1 / 25  T 22  , 22  , 22  , 28  / 


HLKDTA 
JULY 7 6 
JULY76 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
JULY76 
JULY76 
JULY76 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
BLKDTA 
JULY76 
JULY76 
JULY76 
JULY76 
JULY76 
JUL-Y76 
BLKDTA 
KOTA 
BLKDTA 
BLKDTA 


END 
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ooooni 

oooooa 

OOOOOi 

000004 

ooooos 

000006 

000007 

oonoos 
000009 
001)010 
oooo  1 1 
0000)2 
0000  1 3 
0000  1 4 

0000  1 3 
000016 

00001  7 

nooolO 

0 0 0 (1 1 V 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000020 
000029 
000030 
000031 
000032 
0000.33 
000034 
000035 
000036 
000047 
noo  o3i) 
000039 
000040 
0000"  1 
000042 
000043 
0000" 4 
0000"5 
000046 
000047 
000040 
000O49 


f 1 


SUUHOtJTlNF’  CAMF.IlSdNUl  CAMFrS 

C FIIk  DFFIf-fITTOHS  AND  RECORP  LENGTHS  FILES 

' CPMtlOH  /FIU.S  / . ■ FILFS 

1 SLGiP  fLStfliOtCkOFw  ,LCROPW,SURhSl tLSUBH  tACOUIS.LACO  FILCS 

■ 2 »CAHsF  tLCAHSF,CAMERR,LCAHLRtCASF  iLfASF  ♦ YtSOUT  tLYLSU  ' F ILF'S 

• 3 »SinFXT,LSK.fcX,YLStRH<LYt;SER,StCII'UiLSLPTRirAS0IS,LCASO  FILFs 

• 4 »INI>  tUUTP  flACIi  ,LTACU  i C ASOSF  t LC  ASPS  FTLFS 

INTEOEH  SEGJi)  tCROPW  t SURHS I t ATWIU  S t C AHSF  tCAHFRPtCASF  tYFSOUT  FIlFS 

1 .tSIGl  xTtYES£RR»6FGTRUfrASDIStllU)P  jIAClJ  fCASPSF  FIlFS 

C.  FILFS 

C ■ AKGtjMEMI  list  for  fRROR  PkOlESSING  A!.'GL3T 

'COFIMUN  /AKGLSr/  APGLST 

1 MIRrS  iNFaTaI.  tMPFKRStNARG  lARGUO)  APt.1  ST 

DIHFNSION  IARCUO)  APGI  ST 

EkUTYALFNCE.  ( lAKGtARG  ) AAGLST- 

C • AF'gI  ST 

GO  TO  ( I 0 » 20 » 3o 1 90 1 So » 60f 701 f INO  LAmFrS 

to  COHTtF'UF  CAMPUS 

rlPJTl  fltlllPtlOOO)  lAI<r.(  I 1 ,IARG<?)  CMf  ks 

HFTPUM  • CAiIFkS 

20  CONTlMuF  CA^,FRS 

WRITt  (nl!TPt20  00)IARG(  1 ) ,IARG(2)  CAhFPS 

RFTUUM  - CAMFRS 

30  CONTIMuF  CAMFRS 

WRITF  f OIJTP»3000H  H<G( ! ) ,IARG(2)  • CAmFrS 

RFTUkfi  CArlFRS 

40  COMIlkiiF  LAmFuS 

WRnL(oUTP,4000)lARC.(|)  ,1ARG(2)  CAmFrS 

RFfllKN  CAMFRS 

SO  COMltlor  LArifH.S 

RRlTLFoMIPjSOOoHAROd),  ARG(2)  LAmfkS 

RF TURN  CAHFhS 

60  CONTUaiF  LAHFkS 

WPlUCoUIP,6000)lAHt;(t)tlARG(2),  ARG(3J  CAMFrS 

RFIHKN  . . ■ CAMFrS 

70  cOimMuF  CAMFRS 

KRITt(t)UIPt7000)lARG(n  ,1AKG(?)  dARG(3)  < CAhFrS 

RFT"i<n  . CAmFR.S 

lOOO  FORMAT (2Xi5HLAMS  fI2»20H  MODkL  NOT,)  HR  2 - »11)  ^ LAMErS 

2000  F0K-AT(2Xt5hc AMS  d?»30H  ITHAX  NOT  PETwFLN  0 AND  99  - ,12)  ' CAMFRS 

3000  FOK:'AT(?XtSH(.AMS  <I2,29h  IWImO  NUT  RlTwFLN  0 AND  4 - ,11)  CAMFRS 

4000  f ORHAT (?X t20|.nA0  TAMS  Ip. OK  SFOULNCF  NU,  - ,A4,1X|T2)  CAMFRS 

5000  F0R'<AT(2X,5HlAMS  d2,36H  CROP  CALENDAR  COFF,  OUT  OF  RANGt  ~ , CAmFRS 

1 F7.3)  CAMPRS 

6000  F0RMaT(2X,5H|  AMS  ,12t35H  RAD  KlJl  T I-TtHPORAL  MATRIX  VALUE  0 ( , It  , CAMFRS 
1 41!)  - *f5.4)  . CAHfRS 

7000  FOR!!AT  (2X,5Hl  AkS  i12»  CAHF'RS 

i 40H  HAP  FUfLTI“7EMPDRAL  MATRIX  VALUt  IGROl'PF  ,12,4M)'-  *11)  CAMFRS 

fcND  CAMtRS 
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0 t’ 

^ CAM1-R2, 

1,760427*  39058  , 1 

ooooor 

SUDROUTINF  CAMLH2nN0) 

CAMFR2 

000002 

c 

CAMER2 

OOOOO'i 

c 

’ THIS  SUOrOUTINE;  contains  the.  PROCFSSING  error  MESSAOtS  FOR -THE 

CAHER2 

000004 

c 

CAMS  KOOULE 

CAHFR2 

000005 

c 

CAI-IER2 

000006 

c 

File  oeftkitions  and  hecoro  lengths' 

E ILFS 

000007 

COMMON  /FILES'/ 

F ILFS 

OOOOOfl 

1 SEGlD  tLSEGlOfCRORW  ,LCKOPR,SUBHST .LSU8M  ,ACnUTS,LACQ 

FILFS 

ooooo'? 

2 rCAHsf  ,LCA'''SF,CAMERK,LCA«tR,CASF  tLCASF  , YLSOUT  *LVESO 

E ILFS 

000010 

3 iSlr.fX  1 ,LSIfEX,YLSERR,LYESER,SEr-TRG,LSEGTR,CASOIS,LCASD 

E UFS 

nooot  1 

'«  tlNN  ,0UI?  ,TACU  ,LTAro  tCASOSF ,l CASOS 

E UFS 

000012 

INHCfR  SECIO  ,C«U1’H  ,SUI!i'„SI  ,ACol)iS,CAH6F.  ,CAMFRR,rASF  lYESOUT 

FILES 

0000  1 i 

■ 

1 t'STGrxTtYEStRKfSFoIHOtrASOUTOUTP  tTAOU  tCASOSF 

E TLES' 

00001  '1 

c 

files 

0000  1 5 

c 

ARGljHLNl.  LT6T  FoR  ERROR  PROCESSING 

ARGl ST 

000016 

COHMUN  /ARRL^r/ 

AEGl ST 

00001  7 

1 NLRrS  ,NFATAI.,NpfcRR!,,NAH(:  ,ARG(!0) 

ARGl  SI 

000018 

dimension  lAHl.no) 

ARgI.ST 

00001  9 

EOUTVAlENOE  ( lAHGfARG  ) 

AHgI  ST 

000020 

c 

AI.'U  SI 

0000?! 

on  TO  (10,20,30,40) ,InO 

CAMER2 

000022 

10  COMTiNuf 

CAhf  r2 

000023 

WR1TL(oUTP,10O0) 

LAHFR2 

000020 

hfkirm 

CAI.irK'2 

000025 

20  continue 

LAmFr2 

000026 

WHlTt  (oHTP,200[>) 

tAHfpP 

0CIO027 

RF I URN 

CAMFH2 

000U28 

30  CONJlI.'uF 

CAmF  r2 

000029 

wRITL(uUTP,3oOO)IARO(!) 

CAHFR2 

000030 

RE  rORN 

camf  r2 

000031 

40  CONTIMuF 

CAtiFR2 

000032 

WRITE(oIITP,4000)IARO{]) 

CAHFH2 

OOOU33 

RIlllR-H 

LAhFR2 

0000.30 

Jooo  FORMAT 

CAMFR2 

000035 

l6nHCAMS  INPUT  TAPE  SEgTRU  - bEGINNIHG  KFGION  AND  70N£  NOT  FOUND 

)CAHER2 

0000  36 

?000  FOHMATcF’X* 

C/MrR2 

00003/ 

1 57H(,aHS  input  tape  SEO.TRU  * ENDING  REGION  AND  ZONE  NOT  FOUND 

)CAhFR2 

000038 

3000  FORMAT f2X» 

camf  R2 

000039 

1 16HCaM6  INPUT  )APE  ,A6,17h  - HISSING  RECORD  ) 

camerr 

0000«0 

4000  F0RMAT(2Xti3H0LTA  D I STR I OU  T I ON  FUROR  - FLAG  = tU} 

CAmE'R2 

oooyoi 

END 

CAHFK2 
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OOOOOl 

• SUBKUUTIWE  cams 

cams 

000002 

c 

CAMS 

000003 

c 

THIS  SlIiiRUtJTlNf;  IS  THE  DRIVER  FOR  THE  CAMS  t-inOHLEt  WHICH  CALCULATtSCAMS 

000000 

c 

THt  fSTIMATFD  PHOPOrTtUH  OF  WHEAT. 

CAMS 

000003 

c 

cams 

O0O0O6 

COMMON/TH  A IMS/  C0UN.7  f I »fc  G7 1 1 ZONE  7 f I STR  A7  r 1 SUB  7 1 1 St  G7  t 

1 F'A  I NS 

000007 

) TTK  111(9*25) , IT  TOT  *THM  (3*9, 2b)  *11)0(3*9,25)  * T V V ( 3 , 9 , 25 ) , 

TRAINS 

000000 

1 T1>TrI'L*II2ULH(9)  *TI-F.ST(4)  *TPFKR(uj  * TFRTO T ( 3 ) * TM  ( 3)  * T V ( 33  *TB(3) 

TRAINS 

000000 

1NTM7FH  nZULlI 

TRAINS 

OOOO  1 0 

OTFFNFinH  ITRAlMOaO) 

TRAINS 

0000  1 1 

■ EOUIVALf-HCtdTWAlW, COUNT) 

TRAINS 

00005  2 

■ c 

SrATlSTifAl  INFURHaIION  Fur  LtM 

stats 

000013 

COKHON  /stats  / 

stats 

OOOOM 

1 TTFk  ,NSEaTH,NCAHSl.,NYtSR  ,HREC ( 7) *NCASCR *NCASOR 

stats 

0000  1 3 

EnUTVALtUCL  ( Nl.ITLR  > 

STATS 

000016 

c 

STATS 

oonoi  7 

COIUIOU/I  KR0R/TITU9)  * 1 0 A TE  , PtST  I M * TOT  , Al  OCAl  ,FWT0T(3) 

fcRROR 

OOOO  I ii 

1 ,mnTAS(3)  ,LRKAN!)(3)  ,CLTOT  (3)  *CLHI  AS  ( 3)  * CLR AND ( 3)  * DtLl  A , 

error 

000019 

t CROI’D*  7(3,2)  ,m!LT(3)*TT0rIRAlNA*THAIND 

F I'K'OR 

000020 

OTHFUSiOiN  IFRS (90) 

fcRROR 

000021 

EOUTVALFNrKIITLtlLRS) 

F f'ROR 

000022 

KFAl  Mut  I 

tRKOR 

000023 

INIIOIR  TU>*CPOPO  ' 

error 

000020 

'c 

CAMS  COUTROl.  CARD  IH)->UT  DATA 

lamscm 

000023 

COMHOI.’/CAHSCH/  ItlOoFL,  IhUI  TI  * I S I GFX  * I SK I P * 1 T M AX  , I RtP  , I W I ND  * 

camscm 

000026 

1 lC.Rm)R(3,2,  lb)  ♦HSf  3,2,3)  *0(3,2,?)  ,Hf3*2,2)  - 

CAliScM 

00002/ 

RFAL  Ms 

camscm 

00002c) 

c 

1 Ht  COHTROt.  CARD  iNPUl  DATA 

lamscm 

000029 

c 

LFMCM 

000030 

COMMON  /(  EMcM  / 

Lf  MCM 

000031 

1 TlTitUO)  ,tCASF  ,CUhTRY,UTR1AL,RSTART, IPRIMT.STARTRtSTARIZ 

.LMirn 

000032 

? ,rNnic  ,i.Ni)Z  fisu;  ,ifAMs  ,tYfs  ,iac»  , tci ass, istxi  ,iscc 

U MCM 

000033  , 

3 ,1CAs2  ,ICaS3  ,tPRCAN,IRHYEr>,TPRC,AS,ICSFS0,IC5(,CW,ICSESM-ICsStCt 

LI  MCM 

000030 

9'  »TCSfYM»KSESF,  TCSEAC.RStED!  ,RSEED2,RS£ED3,RSFhn9,RStEU5,RSEtD6 

LEnfM 

00003S 

5 ,Rsi  tD7,icsFST,  icstcu,ir,sEYS,icstco,  icstcn 

lfficm 

000036 

DIMUStON  ttSFtlU7)  , 

Lf  MCM 

000037 

DOUnLE  PKCCTSUlN  HSEEI)  , RSEfcO  1 , RS tEo?  , RSEE03  » RSEFU9  , RSEtDb  ‘ 

LFFiCH 

000038 

1 ,RSrED6,PSEED7 

LFMCH 

000039 

■ CUOIVAlIMCt  ( RSt;tD,RSFtDJ  ) 

LF  l-iCH 

000090 

IHTFOIk  RSTaRT ,STAlURtSTARTZ,LNDR  ,ENnz 

LFMCH 

o'ooo'ii 

c 

LFMCM 

0001)02 

C 

PAGfc  EJECT  CONTROL  PARAF(ETERS  FOR  LtH 

PAOFCH 

000003 

COMMON  /PAOtCiV 

pagfch 

000090 

! MPACF  ,MLlNt  ,MXUNt,NSTft  fSOOTTUlO) 

pagkch 

00 00 Ob 

C 

PAI.FCM 

0 0 0 0 '1 6 

C 

rullTRO!  PARAHLTLRS  FDR  UfiM  program 

CMI'>L 

000097 

COHMUH  /CNTRL  / 

CNTRL 

000090 

5 RHInTF »RSTAHr,SfFD(7) 

CF'TRL 

000099 

lUtrOFR  priutf 

CNTRL 

OOOObO 

DOUt'LF  r’RFCISlOM  SFF.D 

LN1RL 

0 (1 0 0 b 1 

C 

* 

cnihl 

0UO0S2 

c 

Flic  OFFImITIONS  and  record  lehotms 

i ILFS 

000033 

COMMON  /Fll  ES  / 

FILES 

oonobo 

t Sfcf.iD  tLShGIOiCROPw  ,LCROPW,SIJHMS1  ,LSUBH  , ACOU 1 S , L ACO 

F )LF5 

oooobb 

2 , cause  .LCAMSFfCAlU.RH.LCAMhRtCASF  ,LCASF  , Y t SOU  T , L YF,  SO 

F TLFS 

0000''6 

3 ,5ir.f  XI,LSi<iFX,YESERR,LYtShR,5EGIRU,LSLGlR,CASO!S,LCAsD 

mlfs 

O0O0S7 

9 ,Tf.P  tOllTP  ,?ACU  ,i  TAClJ  ,C ASUSF  rLCASUS 

^ It  FS 

oudobo 

iMiFuru  Sir, ID  ,cRUPw  ,sui)iir>i TAruuis,CAfisF  , cam! rr, case  ,yfs(h)T 

files 
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00OO59  ^ 

^ • t *SIGExTiYESERKjSI;GTRUf-CASDrSt!JinP  tTACU  ,tASDSF 

KTLFS 

OOOO^iO 

C 

frfs 

oono6i 

C ARflljMtNT  LIST  FOR  FRRUH  PROCFSSING 

apglst 

OOOOfxi 

COMMON  /AROlST/ 

APGl ST 

OO'^O'I  i 

• 1 NIRkS  jNFATAi  tNprHRS'fNARO  tARGdO) 

akglsi 

0 u 0 0 a 

OIMFNSlON  lAPOClO; 

ANGl  Si 

05006S 

EOUlVAlf.NOE  ( UROfArC  ) 

Af-'Gl  ST 

000066 

c ■ 

Al/G!  ST 

00006/ 

CnMHON/StOTRU/COltN4,  IPEP4  • I'ZONEO  t ISTKA4 1 ISU84  t ISE04? 

sfgtku 

00O063 

1 7TtlPKtO«(6),ISf'W,prfR) 

sf  gtru 

000069 

COHMOIVCAMi-  KK/  COUtf?,  THFG2f  I70NF2t  ISTRA2,ISlJB?f  ISF«;>, 

LAW! rR 

00O070 

1 PW(3,«)  .bFl<Rl3f4)  tSlGERRC  3,4) 

CAmFRR 

OOOOVl 

COHMON/AL4UIG/COUN1  ,l!?tnl  t IZORLUISTkAI,  ISUEltlSEGl, 

AFOUIS 

0U0u7d 

1 ll';)N(4,?b)  rTTOTAL 

A( GUIS 

OOOC75 

COHM(jM/CkO'’W/CUIIN  3,  IR(  O'?,  I ZONF  3 , I S t R A 5 , I SUBS  , 

LRUPW 

000074 

1 start  <2,4)  fFfiO(2,0)  VSl)l?)  ,ERR(2,b) 

CK()PW 

00007b 

IfllEGFll  SfA!>T,EM0,6!),EHR 

CI'OPW 

000076 

COMMOM/SlGhX/rmiMb,  tUf  GG,  I,Zf)MEb,ZlU5,?)  i-ZGIGCSiPfA) 

STl.l  X 

00007/ 

COHMUK/I  A'/GT  /fimino,  TKlGi,,  IZOkh  6,  IS  IRA6*  ISllbA,  TSFG6, 

LAjiGF 

000070 

1 Pmi?  , IZDUU'O  ,FrST(4)  .l'FKI?C4) 

LAHSF" 

0000/9 

COMMOK/IMOX/  1,'mtXC  n ,IP0IWT(2  001  1 , IPRT2(200U,1PLNDtIPIN 

lUDX 

O0OO6O 

INTrl-ni  hPEr  MIX, OTH, season, Wlrv-noWjTTPEfMCIOFL 

cams 

OOOO/U 

REAL  M 

lams  ■ 

oooon<e 

DIllFNSIf'N  HFaI){4,4)  ,XIt5)  iHCi)  ,I3CCC3)  tSiGCC  (3)  ,P  ( 5) , 1 4IN00C4) 

LAMS 

0000«3 

DIMFIfSiOM  HOC  16) 

CAWS 

000064 

fOUTVAi  FNCEOtFAO,Ml)) 

CAMS 

OOOuf'b 

DATA  Ho/  ,'IHKlnO  ,4H1)W  1 ,4n«»«r»  , 

lams 

nooo<’,6 

1 j'lHWlMU  ,4H09  2 , 

cams 

000007 

1 liMtttt  ,4M1;JN|)  ,4H0M  3 ,4h»<'««'  , 

lams 

OOOOH'J 

1 4IK#TT  ,4llWlN0  ,4H0W  4 ,4tiA*At  / 

LAMS 

OOOOP9 

data  WhF,  HIX,0TH/1 ,2,3/, IFILL/0/ 

000090 

DATA  ZZ7Z/4H/ZZZ/ 

cams 

000091 

IPtHD  = 0 

00009^: 

IPIM  = n 

000095 

I MR  = 

000094 

IrHD  = 0 ■ 

00009S 

UlSF  = 0 

000096 

NSTTE=4«  • 

cams 

000097 

SI)HTfl(1)  = lH 

cams 

000Q9H 

RUllTTl  (?)  = 1H 

cams 

000099 

SHUT  n ( i)  = lH 

cams 

OOOlOO 

sum n (4)-=6hcams  p , • 

lams 

OOOiOl 

■ ■ SUDTll  (‘i)=oHHORORT 

CAMS 

OOOlOtJ 

Sl'ijrii  (6)=6HjnN  ES 

cams 

000103 

SUilTlI  (7)  = 6HHHATE 

CAMS 

000104 

suBTii  ((u=6n  Data 

cams 

00910b 

SUnT  n f9)=6llRFP0«l 

cams 

000106 

S'lurll  ( )0)  = 6H 

000107 

ini’KlNTF  .1  F.O)  go  TO-S 

cams  . 

0 0 0 1 0 (3 

, ■ CALI  EjFU(l) 

cams 

000109 

winit  fouiPiiooi) 

cams 

0 0 0 n 0 

lool  HIR'1AT(2X) 

cams 

000  1 1 1 

b c Oil  n Nil! 

LAMS 

0 00 1 1 

NRhr(2)=0 

cams 

000  1 1 3 

NREC14)=0 

cams 

0 0 0 1 1 4 

HPhf(6)=0 

cams 

0 0 0 1 1 b 

N'Uf(7)=0 

lams- 

non  1 1-6 

NCAMSFsO 

cams 

noon? 

C()UU4  = 4II 

Ouni  Ml 

im  04:^0 

«NtW 

9NLW 
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000119 

F 

• 

■ ■ irONL9  = n 

0001?0 

lSTf!A/i  = 0 

OOOISI 

1SUI)/1=0 

OOOl?^ 

151  r,o=o 

ooui?3 

'•  cni(Mi=/in 

oonipo 

ll7Lr>5=0 

0001?i) 

. j/u:-((-5=o 

0001?6 

1ST6A5=0 

000 1?7 

1SUM330 

oooi^a 

COl(llb=/iH 

000129 

ii!cr,b=o 

ooono 

0 0 0 1 ."i  1 

..  . 

•“  c' 

I70MIS=0 

CAMS 

0001-52 

c 

iNm/^Li?AnuN 

■ 

CAMS 

000153 

' 

c 

sn  6iLE  flags 

CAMS 

000  1 3il 

1510=0  ' 

cams 

OOP  1 lb 

IChOFKsO  i 

cams 

OUO 1 30 

IF(  JAr(3.t0.fl,AND.UCAl^S,En,3.0R.ICLAS3.F0. 

2,0R,ISCC,E1,P)) 

CAiiS 

00015/ 

1 lci!r>pK=i 

cams 

00015B 

1310=0 

cams 

000  1 59. 

ir  (I  Aro.tn.l.0K.KAMS.tn.5.0R,ISLXT,fc(J.?) 

isir.si 

cams 

0 0 0 1 0 0 

CALI  Inn  KISIG.IACO,  IArC/,ICROHH,ISIGaiF AO 

rlTSFG) 

cams. 

n 0 01  '1 1 

c 

cams 

000102 

c 

cut  OK  FOR  ERROR 

cams 

000103 

IFa/KAlAC.GT.OjRt  TURN 

CAMS 

000 1 00 

IFlTAro.tO.O)  GO  TU  loOO 

CAMS 

0 0 0 1 0 b 

c 

CAfiS 

000  1/(6 

c 

SPECIAL  case  - NO  ACOUIS*  FILE 

' 

cams 

0 0 0 1 /(7 

10  cnuTii'uF 

cams 

000  I'lO 

c 

2FR0  OUT  FRlUm  PARA/lbTtHS 

cams 

0 0 (M  0 9 

00  12  I=7i90 

CAMS 

ooni'to 

11  liSU  )'--0 

CAMS 

ooniyi 

12  cni/TIN|jt 

cams 

000  1 ‘’.2 

11  LORTlNljF 

cams 

non  153 

, 

CALI  iNFirOfltlfOtltOtlnONEtlENIO) 

cams 

000159 

ircionME.f.T .0)  CO  lo  aooo 

cams 

oooiss 

c 

CAMS 

00  0 1 '.6 

c 

SET  UP  OUTPUT  FILF  RtCU(U) 

cams 

000157 

C0UM6=f  OUl./l 

4 

CAMS 

00015a 

IRtr,6=i(/Lr./j 

CAMS 

000159 

I70'(t6=  I2rRF9 

CAMS 

OOOH'O 

• ISTI-'A6=ISTRA4 

cams 

000  16  1 

iriuit(j-;i;iUu9 

cams 

000162 

ist(;6=jSM;« 

■ It 

CAMS 

000163 

|>TRIU-=pTimF) 

cams 

000  169 

$1  ASOU=TSPh,+  1 

lams 

00016b 

DO  50  riliiOOltsl  ,9 

cams 

000166 

1701  U(V(  I M0UW)=START  (SEASON  t window) 

cams 

000167 

PFSTO'iOoO/DcPTHUF 

CAmS- 

000168 

PFRR(WlOi)OM)  = 0, 

cams 

000169 

000170 

c 

30  coNjiAur 

cams 

'cams 

0001/1 

c 

IF  IvlPUPTf  no  RFpnUT 

CAMS 

OOOl 72 

If  (Ptiir-(TK,ir,o)  CO  TO  9o 

cams 

000173 

DO  60  wliJnow=lf'i 

cams 

0 0 0 1 7/1 

DO  52  1= 1 t9 

cams 

0001 7b 

TITI  n )=hFAO(I,V(INDOH) 

cams 

000176 

52  CONTII/ul 

cams 

006177 

10ATl  = l7UI  U(WTNnOW) 

cams 

00  0 1 7!) 

prST  ID^IMRUr 

cams 

«NtW 

♦ IlLW 
+ .MLW 

♦ NtW 
4 Ml  W 
»NtW 
»MLN 
4MLW 
»MtW 

♦ Mhli 

♦ MtW 

♦ NE.W 
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000179 

CALI  tn-PORI (OtWiNDOWfO) 

cams' 

OOOUIO 

60  cntniMut 

CAMS 

oooiai 

C 

■- 

CAMS 

0001P2' 

c 

OUrPUT  PtCORU 

cams 

000103 

4 0 CflMnUuF 

C’A.MS 

000  ! PO 

WIUTfc  f (:AHSHc0UN6,IKfcr,6,IZ0Nfc6j  rSTKA6»  ISUt56t  lSEG6iPTKIJt  r 

cams 

00010*5  ' 

1 ( 1 ZULU (WINDOW) »PFST (WlMDOW) ♦PfcRK(HINOOW) ♦ WINDOWS  1 t 4) 

cams 

000 1 06 

NCAM6P  = nCAWx9U+l 

cams' 

oooin? 

GO  TO  1 1 

cams 

000  KIC 

OOOIP9 

c 

cams 

000190 

c 

PASS  1 - training  StGMtNTS 

cams 

000191 

1000  CONIINUP 

cams 

000192 

• 

CALI  InO  [ (ISEGtlACUtlACOtlCROPWf 1 > I OONL 1 1 1 NO) 

cams 

000193 

. 

iFnooHi;.r,T,o)  GO  ro  i9oo 

lams 

000194 

c 

cams 

00019b 

c 

INlUALT/.ATlOi'l 

cams 

000 1 96 

HnDt'Ls3 

cams 

0 0 1)  1 9 7 

IP ( IMOof L,C0.2)MOOtL=t 

camp 

000196 

* 

SFASUKal  5PWM 

cams 

O0O19V 

JHPSTrC 

lams 

000200 

[>n  20  1=1 14 

CANS 

000201 

1WU'DC)(  1 )s0 

cams 

O0O202 

20  COf.UNUl; 

cams 

000203 

' c 

* 

cams 

000204 

c 

ZERO  OUT  TACO  RECORD  (CaMSF  PART) 

CAtsS 

00020b 

DO  3 0 .iTNOOWs  1 ,4 

cams 

noD2f>6 

1 IZULU(UlMOOw)=0 

cams 

000207 

TPtST  (.<TUDOW)=0. 

CAMS 

000200 

^^'KRK(^I!U■)OW)=0, 

cams 

000209 

SO  cONTIM^jF 

cams 

0002!  0 

wiHnOiitO 

cams 

000211 

too  CONI  INK 

t ahs 

n0021<i 

lALn.'iOrO 

cams 

000213  ! 

h'lNDUiJsWINUOU+l 

cams 

0 0 U 2 i 4 

iK(Wlf'>()nw.GT  .4)  GO  TO  lol 

cams 

00021b 

200  COtiTIUUF 

cams 

000216 

IAC.nNUsIACOMO+1 

cams 

000217 

IF  ( rAC(jH0.GT,2b)  GO  TO  lOO  *■  ' 

CAMS 

00021  0 

c 

. 

cams 

000219 

c 

GFT  NF3!  ACOUISinoN,  JUMP  OUT  IF  NO-  MORE 

CAMS 

000220 

IF  ( IWJnCWINIiOW,  lAConOl  .FO.O)  GO  TO  100 

cams 

000221 

IKdAKjNO.tO.I)  IWItlOO(WlNOOH)  = l 

cams 

000222 

c 

cams 

000223 

c 

ZERO  OUT  FRROR  VAl UFS 

CAMS 

000224 

DO  240  I=7»40 

cams 

00022'i 

1FRS(I)=« 

cams 

000226 

240  CONTlNuf  • ' , . 

cams 

000227 

on  220  1=1 f 4 

cams. 

000228 

IFHS(n=4H 

CAMS 

000229 

220  continue 

cams 

0002  ?0 

c 

cams 

000231 

c 

twiny  lOlNT  FOR  SPECIAl  CASE  - ORDINARY  SEGFiFNT  WITH  NO  CORREL, 

cams 

000232 

c 

(.!  T {;ROPK  RFtORD  - CA!  L INPT  - IF  NECESSARY 

cams 

000233 

3000  CONTlNui- 

cams 

000234 

00023b 

IF(TU^Sf•  ,OT.  6)CAl.L  XMPT(l»!»1»TCROPn,l,,OfinONEtIFNO) 
IFUDOnF  .GT,0)  GO  10  4000 

cams 

00  02  16 

C 

LAMS 

000237 

c 

SET  8/PASS  VAlurs  FOR  CL  ASS IM C AT  I ON  ERROR 

cams 

0002  '8 

UO  30  0 TYI>h=lfi 

cams 
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000239 
0002O0 
00020 1 
000202 
000203 
000200 
00020!} 
000206 
00  020  / 
000200 
000209 
fl002''’0 
0002*}l 
0002*^2 
0002^3 
0002'‘'>0 
n002S‘i 
0002^6 
0002bV 
0002S8 
0002S9 
000260 
000261 
000262 
000263 
Q0O260 
00026b 
000266 
000267 
000268 
000269 
000270 
000271 
000272 
0002/3 
00  0 2 /-■/ 
00027b 
000, >76 
0002// 
000278 
0002/9 
000280 
000261 
000282 
000283 
00028^ 
l)0  02ab 
000286 
000287 
000288 
000289 
000290 
000291 
000292 
000293 

non, ’90 
00029b 
000296 
00  029  / 
000298 


MULT(TyP8)=1 . ■ ■ cams 

XI<Trt‘K)=PV'(TYpEtWINDOW)  ‘ CAMS 

300  CONTIMur  CAhS 

C CAMS- 

C 'IF  lltPASs  CtASSTF.  FKP0|7»  SKIP  DOWN  CAMS 

IF (ICI ASS.e0,2.0R,ICAMS.E0.5)  GO  TO  700  CAMS 

c ■ • " ■ cams 

C 'SET  OYPASS  values  FOK  MULTI-TEMPCHAL  error  CAMS  • 

DO  010  TYPt=l*rtODFL  ' CAMS 

MnYPn  = i.  ■ ' cams 

OlO'CtUmMjF  ' cams 

C CAHS 

C IF  MYPASS  MULTl-KHP.tRHOPt  SKIP  DOWN  CAMS 

ir(iiuiuii.oF.i)  on  to  boo  cams 

DO  020  T YPfc=l tMOOfL  CAMS 

ckl  M(jl  TKTYPEtSFASOAif  iWINOOfHfTYPE))  CAMS 

020  continue  . CAMS  • 

c ■ ■ cams 

C"  Sfl  DYPASS  VAlUCS  FOR  CROP  CALENDAR  ERROR  CAilS 

^00  continue  CAHS 

on  SIO  TYPL=l»MnDEL  . ca.ms 

. DCCffYpF)=0.  ■ • ‘ CAMS 

siGrcnYpE)=o.  cams' 

510  CONTlnuE  . cams. 

' C ' cams 

C 'lE  PYf’ASS  CROP  CAL.  ERROR » SKIP  DOhN  CAMS 

■ IF( ISCC.OF ,2)  GO  TO  600  ‘ CAMS 

■ DO  S20  TYPfc=a  ■.MODEL  CAMS 

CALI  rKnPCSfEO(O) iTYPFiSEASON, WINDOW? TACONOt  CAMS 

1 PcF(TYPt)?SlGCC{TYPt)»USLr.)  CAMS 

520  continue  cams 

C • cams 

C COMPUTE  cl ASSIFICATION  FHROR  CAMS 

600  GONTIMuF  • LAMS 

xi("iyT=o.  cams 

Xl(!'U()=0.  cams 

DO  620  TYPE=ltHOuFL  CAMS 

CALL  CLA6S(RbC0(2)*TYpE,RlND0W»H(TYPt)fHCC(TYP£)tSlr,CC(TYPE)t  CAMS 

1 XI  (TYPE))  < cans 

620  CONTI.Nuf  CAMS 

C CAMS 

C COMPUTE  [>I  ST  . cams 

700  continue  ' ' cams 

P(HME)=I00,  cams 

PIHIXlsO,  CAMS 

PCUTIOsO,  cams 

IE  (n;i)(jFL.ED,2)  GO  TO  710  CAMS 

P(WI!ncPI  (KHL)-PHHrX)»PN(HlXrIWIND)  . CAMS 

P(.AtX)sPf  (MIX)  ■ ■ cams- 

Prorn)=100,~P(HTX)*P(WHF)  CAMS 

710  CO(iriT‘L)E  ' cams 

P!  S = P(wHE)'>Xl(«HE)  + P(MlX)»Xl(EiIX)+P<UTH)»XI(OTH)  CAMS 

C cams 

C EXIT  PUImT  for  SPEClAl  CASE  - ORDINARY  SEGMENT  WITH  NO  CORRFC.  CAMS 

IF ( TUSp.GT.6)  GO  TO  27b0  CAhS 

DO  9 in  TYI’I  5 1 t 1 ' . CA.IS 

|HM( lYpE ♦HlNDOKfIAC(lNO)=HULT(TYPE)  CAMS 

TB»r  lYpf  »UINDO/!tlACONO)=CLOlAS(TYPE)  CAMS 

1 vvf  lYpF  .kimdOw. iaci)no)=c.irand(Type)  cams 

930  rtlUtlMUi  LAMS 
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000299 
OOOiOO 
OOQSOl 
OOOJO(2 
00OSO3 
000309 
000305 
OO0306 
00030/ 
000  30f3 
000309 
00031  0 
000311 
00031^ 
000313 
000319 
000315 
00031 6 
00031  / 
00031S 
000319 
000320 
000321 
000322 
000323 
000  J?9 
000325 
000326 
000  32  7 
00032(1 
000329 
000330 
000331 
000332 
000333 
000339 
000335 

000336 
000337 
000330 
000339 
000390 
00039  1 

000392 

000393 
000  399 
000395 

0(10  396 

00039  7 
00 0396 
000399 
OOOj'iO 
0 0 0 3 ‘1 1 
000352 

000353 

000359 

000355 

(1 00356 

000357 

000  350 


C 

C IF  RtPORTi  PRINT  RbPORT 

If  U’kintf.lf.o)  00  ro  900 

1F(IAC0N0,GT,1)  CO  TO  6lO 
• 00  020  1=1 »9 

mi  U)=MEAD(IfHINOOH) 

02,0  CONTINi/F 
810  CONTIMijf 

IDA-IL=lRlN(WlNDOWt  IAC(3N0) 

PFSTIf^PLS 

TOTsPi S-RT (WHF) 

IMPbTsIFTrtSl  +1 

CALI  RfcPOiU  ( 1 f IFlRSTf IRfP) 

C 

C STCiRt  .VAi  HES  IN  OUTPUT  RECORD 
900  CONTU'uF 

If  UAr(4fO,GJ,l)  GO  TO  200 
T r/.UUl(WlN|;nKl  = IWIN(WrNr)OH,lACQNO) 
TPKSf fwlNnuU)=PFS 
TPERl<fwIilOOR)=f'r:S~PT  CviHp) 

GO  TO  200 
101  CONTUniF 
C 

C SAVF  ON  sCRAICH  DA  FUt  TaCO 
cnuN7=c0UM9 
IRLG7=lRf;r,9 


CAMS 

cams 

LAHS 

cams 

CAMS 

cams 

CAMS 

CAMS 

cams 

cams 

cams 

CAMS 

CAMS  • 

cams 

cams 

cans 

cams 

cams 

cams 

cams 

cams 

cams  . 

cams  ‘ 

cams 

cams 

cams 


1/0N|.7=12IINF9 

ISTRA7=TSTRA9 

lSUt<7=lMJ!19 

15LG7“lSLr.0 

TPTRUFzPTO'.HLl 

If  ( nsFC.cr.o)  00  to  915 

WRlTEf  cAMSI  )COUN/tlREG7,17.0NE7f  lSTHA7«ISUB7»ISEG7t  TPTRUEi 
1 (Tl/lil  Uf  n7TprsT(I)  ,TPtRK(n  tl  = lf9) 

NCAi‘:>i’=  urAtisR  + 1 
GO  TO  lOOn 

915  continue 

on  oin  1=1 f9 
DO  920  J=1»25 
IThUtf  i,J)  = TWINntJ) 

920  COHTI.Vuf 
910  CONTINUI 
.moTrnoTAl. 

CALL  TsAVt (TsEG7f2f lOAO) 

IF(Nf A| AL.GT.O)  KF)UR„ 

GO  TO  lOOO 
1900  CONTINUf 

If  ( ri;0(  f ,nt .?)  return 


LANS 

CAMS 

LAMS 

lams 

CANS 

CAMS 

CANS 

CAMS 

cams 

cams 

1 A MS 
CAMS 
cams 
cams 
cams 
CAMS 

cams 

cams 

cams 

CAMS 

cams 

cams 


if  ( I ISf  C,f  U„0)  GO  TO  /lOQO  cams. 


c 

c pass  2 - ordinary  segnlnts 

2000  CONTIf'ilF 

c 

C FINISH  I AST  hRITE  TO  SCRATCH  FILE  TACO  ' 

CALI.  TsAVF(0,-3,INAU) 

C 

C Rl.niTlAi  I2F  files 

CAl  I iNTTKTSFGt  lACOiTACUf  IC»rtPW,I5lG73lFAl)f  nSf  G) 

1 AcniiOsi 


cans 

cams 

cams 

cams 

cams 

CAMS 

CAMS 

cans 

CANS 

cams 
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0O'0S^9 
0003M) 
000361 
000362 
OOOiM^ 
000360 
00036/ 'j 
000366 
000567 
OOO  J6S 
000367 
000570 
00037  1 
000372 
000373 
000370 
000575 

000576 

000377 

000370 

000379 

00030,0 

000  5K1 
000302 

000305 

OOO.>09 

000305 

000306 

000307 

000300 

009309 

OOO30O 

OOO301 

000392 

000  593 

000399 

000395 

000396 

000  597 
000390 

000599 
000/100 
000/41)  1 
000402 
000403 
000404 
000405 
000406 
000407 
000400 
000409 
0004  10 
0 0 0 4 11 
0004  ) 2 
UOO'il  5 
000414 
00  0/1 1 5 
0004  1 6 

0004  1 / 
0004  10 


c 

2010  CONTINuF 

CALI.  TnPT  (ISer.,IACO»  lACOt  1 *I3lGf2tI00NEtIENP) 
1F(TL>OnF,CT.05  go  to  4000 
. irzPST=o  . 

srAS(jK-=ispw+ 1 
.DO  2005  l=li4 
lHl)40tJ(D  = 0 
?005  CONTIMUf- 

c 

C Zf«0  OUT  CAfiSF  RtCORD 
1)0  ?0?()  HlUOOWs  ! f 4 
I7UUKwIMOOW)  = 0. 

RE6Ta!l^'OOW)=0. 

Pf-RR(WlNl>OH)=0. 

2020  CONTIK'UF 
WiKOUWzO 
?100  CONTI hlljE. 

WlN'iOVi  = HlMDOw+l 
lF(l!it,|)r)h.CT,4)  CO  TO  2101 
iFCIrilNfRlMPO'ff  1),EO,0)  GO  To  2100 
IWIllDn(WINDOrf)  = t 
C 

C ZERO  OUT  IRROR  VaLUFS 
DO  2110  1=7,40 
ICKS(I)=0 
2110  COMlNlJf- 

DO  2120  1=1,4 

IIR,0(J)=4H 

2120  CONTINUF 
C 

C CORfitI  ATf  WITH  TRAINING  SEGMENT 

CALL  foRRFLdTMAX,  IWINC  WINDOW,  n , WINDOW,  lUSE) 
1FUUSe.GT.6,A!JD,ISKIP.IE.O)  go  to  2100 
IF(IU‘.(..(,T,6'.AND.I6KlP,r.h,I)  GO  TO  3000 
DO  2200  TYPF=1,3 
XT  tlYPp)=0. 

2200  C'^UTINUF 
C 

C CALCUl  ATt  SIOMATURfc  tXlTNSION  ERROR 

IM  ISFXT  .FlJ.2,0R.  ICAU.s,pO,3)  GO  TO  2400 
I/O  2500  lYPFslTNuntL 

CALI.  .0(;hXTl?fcf  D(3),TYPt,WlND0M,  lUSbtXI  (TYPE)) 
2500  cONTINuf 

CO  TO  2600 
C 

C SET  OYPA.5S  VAUIFS  FOR  SIGNATURE  EXTENSION 

2400  CONTUniF 

DO  2300  lYPF=l,MOntl 

XT  (TtPt  )=PW(TYPE,WiND0Wl»(l.+TERTOTCTYPm 
2300  CONTIMIIF 
C 

C COhPUTt  Pl  ST 
• 2600  criNTIMul 

p(WltU  = lU0. 

PfOIX)=0. 

proT/OzO. 

IF  ( inofil  L,t0.2)  GO  TO  2610 
Pftt!in=PHWFfE)-PT(MIXl+PW(MTX,IMIND)  • 
IMMlXTsl'Ul'IlX)  ' 


CAMS 

CAHS 

C'AMS 

CAllS 

cans 

cams 

cans 

cams 

cams 

cams 

CAMS 

cams 

CAMS 

CAJIS 

cams 

CAMS 

cams 

cams 

cams 

cams 

CAMS 

cams, 

cams' 

CAMS 

cams 

CAMS 

cams 

CANS 

CAH.S 

CAMS 

cams 

cams 

cams 

cams 

cams 

cams 

cams 

cams 

cams 

cams 

cams 

cams 

cams 

cams 

CAMS 

CAMS 

cams 

CAMS 

cams. 

cams 

cams 

CAM.0 

CAMS 

cams 

cams 

CAMS 

cams 

CAMS 

CAMS 

cams 
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000i)19 

P(OTH)  = 100.-tJ(MlX)-P{WilF) 

cams 

000^)?0 

?6I0  I'.nNTil/ut 

CAMS 

noo/i?i 

PFS=P(wHt.UXl(HHU  + P(MlX)'fXI(MlX)+P(OTH)+XI  (OTH) 

cams 

2750  CnivTJNur 

CAMS 

C ’ 

cams 

ooi)n?i\ 

C IF  RhPOKrt  REHtRATt,  RfPnKT 

cams 

Oi)on?b 

IF(PHInTF.UF.O)  go  to  2700  ■ ■ ■ 

cams 

0<)0tl?b 

00  2000  1=1 T« 

CANS 

OOfl^4?7 

Tm(l3=HKAn(l7WINDOW) 

cams 

OUO/|?3 

2000  CONTltitjF 

cams 

000/|?9 

• ll)ATt  = rHII)(HlH006t  1 ) 

CAMS 

000/1  ■^O 

PKS7i’-'=KS 

CAMS 

OUft/151 

TnT=Prs-PT(WHF> 

CAMS 

ouoa'^^i 

If  (If^noFL.tQ.2)  P((JTH)  = 0. 

CAMS 

oon/]^,s 

JFCU.Sf  .07.6)00  TO  2650 

cams 

Al=(l . +TCP rOT (6HD )»PW(MHF,H1ROOW) 

cams 

000/ny 

A2=(l.+TLPinT (MIX) ) «PH( MIX, WINDOW) 

cams 

oon<(  <6 

A3= ( 1. +T tRl nr (offO) ♦PH (OTH, WINDOW) 

CAMS 

000457 

Al=Af1!NllAItl.) 

cams 

000450 

APrAt’.TN)  CA2tl  ,) 

cams 

0004'59 

A 5=AMTn1 (Ait  1 .) 

cams 

0 0 0 4 4 0 

Al=AHAxl,(AltO.) 

CAMS 

000441 

A2=Ar(AXl  (A2i0.) 

cams' 

00044<J 

A3=/lHAXl  (AitO.) 

cams 

000445 

ALOCAI  = PCwUhlf'M  +P(m1X)*A2  +P(0TH)*A3 

CAMS  ’ 

000444 

T10=IPKl0R(luSt) 

cams 

00044b 

■ 711401  = 0, 

cams 

000446 

2FKfV=rt. 

cams 

000/i/|  / 

IF  ( ALO(;AL.fcO.O,)2FR01  = .0  000  0'j 

CAl.S 

00  4 4/16 

If (PtF.ro. 0.)  27 KO2=.o00O0b 

cams 

004449 

TPAINA=(  (PtS+/f  RO?)/(ALOCAL  + 2f.ROt  ))  + 100. 

cams 

000/150 

TPA'lNn=(PFS-ALOCAL)/(ALnCAL+ZFR01)*lOO, 

cams 

OOfl/lM 

GO  TO  2«60 

cams 

00045^ 

2850  COMTiNi)f 

■ LAMS 

0044S5 

/ 

AI.UfAl  =Pi  STTN 

C AMS 

000/IS4 

2(ltn=OtLlA 

cams 

oooabb 

2f2tl)=!  Lf!AT(CROPO) 

cams 

0O04S6 

Z(l»2)=tiUL  HI) 

1 

, 

cams 

0004S7 

2(6t6)=MUl  H2) 

CA[|S 

0004')!) 

2(3f2)=»U|  T T3) 

CAilS 

0004'')9 

T I0-99V99999 

00/)400 

lRA7f!/\  = 0.  t 

'9'» 

cams 

000461 

lRAli-n=0. 

cams 

00046^ 

2860  COKTINof 

ftrt  ^ • 

CAMS 

0004/'3 

11 IR6T=TFTUST+l 

cams 

0004/)/! 

CALI.  F’tPORH2»lFIRST,TRFP) 

cams 

00  04/)b 

C 

81 

cams 

000/166 

C STORF  VAlurS  IN-  OUTPUT  RrCOR!) 

CAMS 

000467 

2700  COiniMi/fc 

cams. 

00046U 

l/UI.U(MlNOOW)  = lHlN(WlMDnWf  1) 

CAMS 

0 0 0/469 

P!  6T(1  il!OOW)sPl  5 

cams 

0004  70 

prRR(wlMDnw)=Pk4-P  f (HflU 

cams 

000471 

GO  TO  2100 

cams 

0004  76 

2101  CONTlNiil 

cams 

000473 

C 

cams 

000474 

c wRi n in  OUTPUT  f tlf 

C AMS 

0 004  7b 

CflUN/)  = ( tH)M4 

cams  ■ 

000476 

lRtr.6=iRtr,4 

cams 

000477 

I70NL6=TZ0Hr4 

CAMS 

0004  /» 

ISTPA6=ISTRA4 

cams 
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oona79 

ooo/tno 

ooo'ini 

00041 

ooo/tnj 

0004100 
oon/jf.s 
000006 
OOOOP7 
OOOOR6 
000009 
OC009U 
000091 
000092 
OOOOOi 
000090 
00009'J 
0 0 0 41 9 6 
00OO97 
000098 
000099 
OOO'jOO 


lsun6=isuno 
lStr,6=lSCP0 
PTKUK=pT (WHF } 

WUlTt  )cnUN6tIREG6,rZ0Nt6f  ISTRA6tlSU86?ISEG6t 

t PTRuf- 1 (I7UI  U(n  fPtSTd)  iPtWR(nd  = liO) 
nCAMSP  = NCAI'lSR+  1 
GO  10  2010 

c 

C OONf-  processing 
aooo  coNiiMor 

iK(Mf-AiAL.GT.O)  RETOKN 
ITOT  = l cAilSI-l 

WPIltrcAHSM  ZZZZf  (iFlUtlsl  tlTOT) 

RlKINfi  CAPSF 
Rtrilun  SEGTRU 

IKdOni.Lr.O)  REWIND  ACDUTS 
IFdAClJ.Lf  ..0)  HfcKiNl)  CAKtRR 
If- dtR0PW.LE.O3  REWIND  CRDPM 
ikisig.U'.oi  rewind  sir.txi 
IFCTACQ  .LE.  03CAI.L  TSAVtIOt-l  t IBAO) 

Rf-  I URN 
■ ■ LND 


cams 

CAMS 

CAMS 

CAMS 

CAMS 

CAMS 

cams 

cams 

CAMS 

cams 

CAflS 

cams 

CANS 

cams 

cams 

C A MS 

cams 

CAMS 

LAMS 


LAMS 

CAMS 
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O ! Cr  CAMSIMt  1 t760«L’7t  3'»i03  t 1 


SUBfJOUTTNr  CAMSTN  • ( 

C ■ FItt  OFKINITTOMS  AND  RFCOKD  LtNDTHS  . i 

COW-iOtJ  /FUKS  / ■ '.  • ■ f 

1 str.iD  Ttser.iotri'inpw  ,lcrofw,subhst?lsubh  tAcfiuiSiLACN  t 

2 iCAMsF  ,Lt:ANsrTCAM£f;»,LCAMtWf  CaSF  ,LCaSF  * Yt<SUUT  ,l.ytSO  f 

3 tSK  L'XTtLSlGt.X,YtSERH,LYeSfcKfStGIRU,LSfcf;rRtrASDISfLCASO  ( 

a »0I17P  *TACU  fLTACtj  t CASUSF  .ICASDS  i 

IHTFi.Ff!  SfcGiD  ,CPOF'W  t SHUHS 1 f ACDII I S f f AMSF  tCAHFXRiCASF  fYFSOUT  ( 

t FSir.FxTfYkStHliFSF(;TKllfrASurSFO!JTP  tTAClJ  tCASDSF  f 

: f 

pAr.H  L.itrT  cfiNTHOL  fahancteks  for  lem  f 

CONMON  /PAGeCM/  ( 

1 MPAot  tNUNh  fMXUNt,NSTTL  tSUOTTLdO)  f 

: . ' f 

; ARGu'-'tNT.  Ll5>r  FOR  FHRUR  PROCESSING  t 

COM'iOM  /ARf.LST/  t 

1 M(.I.'hS  jNF'aIAI  tNPERRS,NAHG  »AKG(10)  t 

UIMFN.SlON  IARGU.O)  t 

tOUIVALFHCt  ( FAHOfARG  ) / 

: ■ ! 

: TAM5  CONTROL  CARD  TNPUT  DATA  ’ I 

COMHOW/rANSCM/  IHOl>fL,IMULTI*ISrOFXfISMP»ITHAXtlRtPt  r«INO»  C 

1 lnROUR(3T2rtb)»HS(3,2f3)Tf.(3»2t2)tH(3T2F8)  C 

HFAI  Ms  C 

: ■ I 

OlNFNSlON  IrHK(0,?, tb) FrHKH(ar2t3) »?bFO(af2)  I 

OIMFOr-lOH  CHKG(a,2f2  )frHXH(aF2»2)f  ISC(A|2J  C 

DAFA  t ?r/) Of  10,  10 f 1 1 » { 2, 12. 1 2f F V t 

DATA  riiKH(lFlfn»ruKM(l,2,n,niKM(2FltniCFlKH(2,2»l).  ( 

1 rilt<M(3.l.I)  .n)KM{3,2.n  .CHKHCRf  1 . n tChKH(0.2,  n 

DATA  Ff;tiKn,l,n.ICHK{l,2,i),lLHhClFl,2),ICHKn,2T2W  • ( 

t IoF'kF  1 » 1.51  F KHk(  1 ,<:,3)  , lCH^f  1 . 1t-)1  , ic'mn  ,2.a>  . ( 

1 lCHh(2,l.  1)  , ICHK(2,2Tn  .ILHA(2.1f2)  . ICF!K(2.2.2)  . C 

1 ICIihF2.1.3).rCHK(2,2,5).lCHK(2.1fai,FtHK(2F2.a).  C 

1 rCPKf3,lFn.ICHK(5,2,n.ICF!KC3tiF2),UHK(3.2.2).  C 

1 ICHkCJ,lF51.rU!K(i,£;,3).TUtK(5.l,AT.lCHK(3.2F'n.  ' C 

1 1(  hK(A.  I . 1 ) . ICHKlif.?,  u > ICHK  (0.  ! ,21  , lCHK(0f?,2)  , C 

1 lUIrff  a,  I f3)  . ICHl\(a,2.i)  . aHK(((.  1 F A)  . ILH^^a,2,aT  1 

l/l.tFl.t.l.l.l.lFl.i.l.t.l.l.l.l.trl.lrl.l.I.l.t.t.Ifl.l.lflitft./ 

: c 

: HEAD  IN  aNO  CMFCK  CONTROL  -CARO  (. 

RFAIMlNP.lOOoUMUl'ELFlMULIlFlSinEX.ISKlP.IIMAX.lKEPFlvaNO.  t 

I ICAMs.IShOl  I 

lOOO  FOKHAT(ai|  .12,11, n,66X.Aa»!2)  C 


: ECHO  nUF  rONFRoL  CARD 

CALI  FjFCT(«) 

WRIILFOIIIP,  ! 100) 

WRlThFLtniF’.llOO) 
i^RlTL(ni)iF»,linn 
JlOl  FOFnAT(l'>X. 

1 SOIIC  AMS  INPUT  CONTROL  CARDS 
WR1TE(0"IP, I JOO) 
hRUF  (oUlP.l  100) 

IlOO  FOR"AF(?X) 

hRl'MdliFP.  1200) 

1200  FftKl'AT  ( 5x,0HlMUtn;L.?X,0(iIMULn  F?XF6HISIOtX»2X.‘3HISAIP.2X»SHnMAXt 
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0000S9 

1 2Xf  AHlKFP»2X,‘5HlrtIND) 

caksin 

OOOOf^O 

WOITl.  fol'lP,  1 500)  IHOL-FL.lHUUIfI5IGFXtlSKI0tlTHAXf  lOtPiinlNDi 

LAllSiN 

OOOOM 

1 ICAObf IStOt 

camsin 

OOOO^H 

130  0 

F0RMAT(''X»I1  t7XtIl  f7x,  11  t6Xj11  f6Xtl2t2Xt2(9Xf  intSXtAOt  121 

CAHSIN 

OOOU^.i 

WKin  {(jtiTOf  1100) 

L Ann  IN 

0 0 0 0 <1  '1 

c 

LAlinjN 

0 0 n U /,  5 

■ c cHurK  ID  AND  r>t.n.  wo. 

LAHSlN 

0000^6 

IFUCANS.lU.'lHCAMS.ANn.ISF.Ul.rCl.l)  GO  TO  1 

LAIISIN 

0000^7 

NA«r.=? 

LANS  IN 

OOOOAB 

lAKGC 1 )=irAMS 

CAllSlN 

OH  00 69 

lAKGl?)=ISt01 

cans  IN 

000070 

CALI.  FilKHFS(«HCAMSf6HcAMSTN*6«  1) 

CAMSlN 

OdOOM 

GO  TO  ? 

CAHSIN 

00007a 

1 

CONT16U6 

cam.sjn 

000075 

IMthlND.rO.O)  IKINt)=U 

CAllSiN 

O('007« 

lAMKl  ) = 1SL01 

CAHSIN 

00007^5 

IAKG(?)  = IHOI)fcL 

cams  IN 

000076 

c 

■ 

camsin 

000077 

C CHtrK  COt.TKOL  VALULS 

C AMS  IN 

000070 

' 

IF  CTMn(;ru,HF. l.AN0.IHnDFL«N2.2)  CALI  FKRHFS f 9HC AHS 1 6HC AMSIN , 1 f 1 ) 

CA11SJN 

000079 

IFCloUt  TI.NF,0,AND,T«I)LTI.NE.U  ikulti  = i 

CAHSIN 

oooo«o 

IF  (TGlfirX.MF.O.AND.ISIGFX.NF,  1 ) ISIGLXsl 

CAiiSjN 

OOOOHl 

IfdSKlP.Nt.O.AMO.  IvSKTP.NF.l)  ISKIPsl 

CAHSIN 

oooof’a 

IF  (tlU  P.Nr,O.ANn,IWf'^’-PF«  1 ) lPtP=l 

CAHSIN 

oonooi 

NAHr.  = /’  * ‘ 

CAHSIN 

oooo«a 

IARr.(')=ITHAX 

CAHSIN 

00006b 

IMni‘f,X.n.O)  CALL  ERUV.ES('fijCAMS*6HCAHSINf2Tl) 

camsin 

OOOO60 

IAH(T(?)  = IHIMd 

CAHSIN 

000067 

IKlHthD.l  1 .t.UR,  IwINO.GT.O)  call  £PK8t  S ( <!HC  AKS  *6HC  AHS  I N»  3 f 1 ) 

CAMSIN 

000060 

CAHSIN 

000089 

C 

camsin 

000090 

C KFAR  TN  CHhCK  MUU  J-TfUPOHaL  SAMSUNG  HAIRIX 

camsin 

000091 

2 

CONTK  Ut 

CAHSIN 

oooooa 

IF  LAG=0 

camsin 

000095 

P'tXTFl 

LAJtniN 

000090 

CALI  I'aGLGCO) 

camsin 

000095 

W«ni.foUTPf2200)  n»I=5.,15) 

camsin 

000096 

2200 

FOHMT  (3X,6HIGR0UP,  I 1 ( IH  ( » 1 2 f 1 H)  * 1 X ) t 3X  1 2HM2  , SX  1 2HM  3) 

CAHSIN 

000097 

DO  20  r=lt2  < 

camsin 

000096 

DO  21  ,1=1,9 

CAH.SIN 

000099 

lULXT  = lt.’tXT  + l 

CAMSIN 

oonioo 

Rt  AD(  T(jP,200  0)  (ICHK(J,I.,K)  .K  = 5,  15)  r 

CAMSIN 

0001 01 

* 

t (rHKM(J,I'nK)  ,K  = ?,3)  , lCAHS,IStO(J,n 

CAHSIN 

000102 

?000 

FORMAT(  1 ni,2X,2Frt,3,5iXtAii,ia) 

CAH.SIN 

000103 

IF  (ILAHS.ro. OHCAMS.AUi;.  [oFQ(Jti),FO,lTJtXT)  GO  TO  22 

camsin 

000109 

If  L\Grl 

CAMSIN 

000105 

lAKGCl )=IFAMS 

CAHSIN 

000106 

IAK(.(?)  = IShO(JTl) 

camsin 

000107 

CALI  fRRMF5C6HCAMS,6HCAMSIN,9,l) 

camsin 

0001  ofl 

22 

C ON T I Nor 

CAHSIN 

000109 

C 

CAMSIN 

0 0 0 1 I 0 

c echo  out 

camsin 

000111  . 

WRJ,TL(0'JTP,?100)  UCHK(JtItK)  .8  = 5,  IS), 

camsin 

0001  1 2 

1 (CMKM(J,I,K)  ,K  = 2,3)  ,lCA''!S,IStO(  Jfl) 

CAMSlfT 

0001  1 5 

2100 

FOKHAT(llX,10(Il,0X),Il,5X,a(Fb.3?2X),A't,I2) 

camsin 

0(M)1  10 

21 

fONTlNHi 

CAhsjn 

0001  15 

20 

cnllTlNut 

CAIISIN 

0001  1 6 

C 

C A. S3  IN 

0 001  1 7 

c 810VK  TNTo  AOIIAY 

CAMSIN 

0001  !« 

NAhi;=5 

CAMSIN 
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000119 

IT0T=3 

CAMSIN 

000120 

1WHFK=0 

cams IN 

OOO'lPl 

17  (TMni)FL,F.0.2)  IT0T=1 

cahsin 

000122 

IF(I'^nDrL.tt3.2)  IWHFR=3 

CAtlSiN 

000123 

ifuh.ar.hj.i  .nK,iiiui.Tr,EQ,n  go  to  4o 

LAil.MN 

000124 

00  30  1=1 f2 

CAHSIN 

000  l?lj 

(10  31  J=1,17{}T 

lahsin 

000126 

L=JfJl"Ml  l< 

CAHSIN 

000127 

ir.Rm;F’(Jfitl)  = i 

camsin 

000  12<> 

ICKmjPf  JtT,2)  = l 

cahsjn 

000129 

ii;ki)ur(J*t,3)  = i 

CAHSIN 

000130 

lof<fniP(.i*  1 .4)  = 1 

camsin 

000131 

no  32  K = l>il‘> 

CAMSIN 

000132 

IAHr.(i)  = isKQ(L,T) 

camsin 

non  1 33 

X 

II 

CAHSIN 

OUOI 34 

IARO(  3)  = lriiK(L,I,K) 

camsin 

OOO 1 3S 

inTC.l'KtLf  I.ilO  .LT.l,UR,lCHK(Lfl«K),GT.31  CAUL  ERRHES(4HCAMSf 

C AhS  I A( 

000136 

1 AHCaHSTIi*  7t  1) 

lahsin 

000137 

ir.RnoP(,JTl  fK)  = ICHKatl  ,K) 

CAHSIN 

0001  3(1 

32 

COI(T  It-njF 

CAHSIN 

000139  . 

M3(.IjI,  n = i. 

camsin 

000140 

09  33  k=2.3 

CAHSIN 

0 00  1 0 1 

IARr.(2)=K 

camsin 

0 0 0 1 '1 2 

Al;o(31  =aiKI1(L  ' I tK) 

camsin 

000  143 

IKDiKkCU.  UK)  .LE.0.0  .OR,  CHKM(LTlfK).GE.CHKH{LfI»K-n) 

CAMSiAf 

000144 

f CALI.  ri(RMES(4HCAMr;f  6HCAMSlNt6f  n 

camsin 

00014b 

H.3(J»I,K)=CHKM(L»I*K) 

camsin 

000146 

33 

CONTI  Hijl 

CAIISJN 

0 0 0 1 4 7 

31 

COIiTIMitF 

C AMS  IN 

000140 

" 30 

t.ONrit-uF 

CAMSIN 

000149 

camsin 

000  1 f,0 

C 

CAIISIN 

OOOIM 

C RL'AO  IN  AN17  CHtCK  CKUP  fAlhNOAH 

camsin 

0001S2 

40 

COUTINljr 

CAHSlN 

oonr'3  ^ 

CALI  1AG1IM6) 

camsin 

ooo 1S4 

W’lTL  (i)HTPf  1 100) 

camsin 

OOO IbS 

W»ITt  (olllP»4000) 

CAHSIN 

0001S6  ■ 

4000 

F0('iMAT(4X,i(2H6l  »6Xt2HG?»6X»2HHI  r 6X 1 2HH2 f 6X ) ) 

CAHSIN 

oonisy 

DO  41  1=1,2  ' , - 

camsin 

ooo 1 se 

IHtXr=lNtXi+l 

camsin 

000  l')9 

Ri  AIK  TnF»404o)  (CIIKCK  1 ,I,J)  , J=  t ,2) , (CHKH(  1 ,1  ,J)  ,J=I  ,2) , 

CAllRiN 

000160 

1 (CllKfK2fIt.nfJ=lt2)r(CHKHl2,lfJ),J=l,2)t 

camsin 

0 0 0 1 6 1 

1 • (CliKr.(3trtJ)tJ=l»2)»(LHKH{3,I,J)Tj=l,2) 

CAHSIN 

000162 

1 » TCAtiSi  I6KKI » t) 

CAnSlN 

000165 

4040 

F0RMAT(?(Fl'.3tF6.?,F6.3,F6.2,  lX)f  2(F6.3,F6,?)  ,’a4,I2) 

camsin 

000164 

IFULAHS,F(J.4HCANrj.  ANp.lbfU  Cl  » 1 ) ,LO.  IMLX  D DO  TO  42 

camsin 

OOO 1 6b 

• 

1FLAG=2 

CAriSiN 

000166 

NARD=2  : 

CAHSIN 

0 0 0 1 6 7 

lAHr,(l)  = lCARS 

camsin 

000168 

JAHr.(?)  = ISl  0(1, 1) 

camsin 

000169 

CALI  IrRMFOC  4HCAnr),6tlCAM5lN,4,n 

CAhSIN 

000170 

42 

LOflTinuE 

CAHSIN 

OOOl 71 

WRITF  f(iMTP,4lOO)  ( L HKfl  ( 1 , 1 , J ) , J = 1 , 2 ) ,(CHKH(t,I,J),J  = l,2)f 

cams  pi 

000172 

. 

1 (CMMK2,  T»J)  cJ=U2),(CllAH(2,l,J),J=l,2), 

CAHSIN 

000173 

1 (CHMK3»  1 1 J)  ,J  = 1 ,2)  , (CMKH(3j  i »J)  1 J=1 ,2) 

CAHSIN 

000  1 74 

1 , ICAKS, TSF8C i» n 

CAHSIN 

00017b 

.4100 

F0RMAT(2X,3(F<’.3,2X*1  6. 2r  ?X  ,F  6. 3, 2X  ,F6.2,2X)  , 2X  , A4 , 12 ) 

camsin 

000176 

lNLXr=iHLXTFl 

cams  IN 

000177 

hi  Afi(  l(jP,420  0)  CLllhDC  4 , T t-J)  * J = 1 ,2)  * CCHkH  C4t  J ,,l)  ivl=  i ,2)  , ICANS,  ISFOlCAiir.lN 

0 0 0 1 78 

4200 

F0«MAT{2(7  6,iK'6.2)  ,bOX,A4,  12) 

camsin 
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000179 

lF(ICAMS,F(J,0HCAMvS.AN0.l6EUl,E0.INt!<T)  KO  TO  03 

CAMSJN 

oooino 

1FLAG=2 

LAHSIN 

OOOlJil 

IAKG( 1 )=1CAMS 

CAMS!  A) 

OOOJft2 

IARC{2)  = ISl.ni 

camsim 

oooiai 

CALI  TRRHFS  C OtIC  AMS  , 6HC  AMS  I N , (J  f 1 J 

cams  IN 

OOOU‘<) 

03 

CtlNTlMuF 

LAllSlN 

0 0 0 1 Ob 

WRlTLfuinPi7i300) 

LAllSI  N 

000106 

1 (rHKG(9,l,J),J=!  r?)  t'lCHKH  ( 4 1 1 , J ) t J=  1 » 2)  1 1 CAMS  » I SEO 1 

CAHSlN 

000107 

71300 

F0HMAT(?X,2CF6,3?2XtF6.2i2)l)  t66X»  A/Jtl?) 

CASSIN 

000100 

01 

CONTlNUl 

CAttSlN 

000109 

c 

CAKSIN 

000190 

C MOV^  INTO  ARRAY 

CAIISIN 

000191  ' "■  ■ 

IF(IH  A(;.fc0.2.  ) GO  TO  bo 

CAMS IN 

000192 

• 

NAHr,=  2 

cahsin 

()0019i 

00  SI  1=1 f 2 

LA  MS  IN 

00019« 

DO  S2  J=1,IT0T 

CAMSIN 

00019'j 

L=J+lWHtK  . 

CAHSlN 

000196 

lAKr.U)  = IStG(l,l)  + IhHFR/4 

CAMSIN 

00019V 

ARG(2)=f  MKGCLTltU 

CAMSIN 

000196 

lF(ADS(CriKi;a>l.m.GF.lO.O  ) call  FRHHFS(4»CAH$,6HrAMSINtS.  D 

CAMSIN 

000199 

ARb(2)=niKHf  Lt  I » n 

CAMSIN 

000200 

IFlAHScriiFHfLjI.  n ).GF.10.0  ) call  FRr!HFSC4!lCAM?t6HCAMSINf  btl) 

CAMSJN 

000201 

Ain,(2i3n!Koa»ii<7i 

cams IN 

000202 

IF(A»5(I  HH(;tL»l»2)>..GF,lOO,0)  CALL  fRRMF  S ( 4llC  AMS  f 6HC  AMS  I N , 5 1 1 ) 

cams  IN 

000203 

AlU.(2)=cnKtf(LTl»«i) 

CAMSJN 

000200 

If  lAbStrUKHfLf I'2)3 .GFotOO.O)  CALL  tRRMFS(4MCAMS,6HCAMSINi bt IT 

CAMSJN 

00020b 

CCJrIt  l)=ChK[;fL  ilfl) 

CAMSIN 

000206 

G(JTl.2)=rHKG(LTlT2) 

CAMSIN 

000207 

fif  Jtl.lT=ritKn(L»ItlT 

CAMSJN 

OO  0206 

Hf  Jtli2T=ntK||(Lil*2) 

CAMSIN 

000209 

S2 

LDI-iT  U u^ 

CAi-tSlN 

0002')  0 

■51 

COMTIttijF 

CAMSIN 

0002)  1 

bO 

CONTINUE  ■ 

CAMSIN 

0 0 021  2 

Kt-TURff 

CAMSJN 

00021  3 

t.hO 

CAMSJN 

'4%- 
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000179 

IFCICAM.5.FO,9HCAMS.ANO.lSEOl.EO.INtXT)  GO  10  «3 

CAMS  IN 

OOOlfiO 

1FLA0=2 

CAHSIN 

0001/U 

IARO( 1 )=iCAMS 

CAMS)N 

IARO(,->)  = I.Stni 

CAM.SIN 

OOOlfli 

CAU  ' BRRHFS  (9HCAHSr6HCAMSlNtOt U 

CAfiSlN 

000 

93 

CONTlNijF 

t A,!SIN 

OOOlfJb 

WRlTL(0inPi«i00) 

LA MS  IN 

OOOU’.O  • 

1 (rHK0(9,I,J),J=lt?)»(CHKH(tttI»J)f J=lt2)»lCAKS»lS£01 

CAHSlN 

oooin? 

/I300 

F0KHAT(2Xt2(F/>,3t?XiF6.2»2X)  i66X,A9»I?) 

CAhSIN 

ouoinu 

9 1 

continuf 

camsin 

()001fl9 

C 

LAMS  I N 

000190 

C.  MOVE  INTO  ARRAY 

CAMSIN 

000191 

IFCIM  aG.MJ.2  ) GO  TO  50 

CAJISIN 

00019H 

K'ARr.=  ? 

CAHSIN 

000 19i 

, 

DO  51  1-1.2 

camsin 

000190 

00  52  J= 1,1  TOT 

CAM.5IN 

000195 

L = J+lWHfK  . 

camsin 

000190 

lAROCl  )=lSt0(I,n  + ihhfr/9 

camsin 

00019/ 

AR0(2)=r  IIKGC1.,1t1) 

camsin 

000190 

lF(AO5(CHKOa»Itl)).GF.l0.0  ) CALL  FRRMFSIOHCAMS  ,6HCAHSIN,S,  1) 

camsin 

000199 

AR6(2)=niKH(L»I » 1) 

camsin 

000,100 

IFtAiiScfRI'Ha?!,!))  .Gf.IO.O  ) CALL  ERRMI  S (9HC  AMS  tAHC  A -15  IN»S , 1 ) 

CAH51N 

000<10l 

AfU.(2)=nit<oa»1 ,2) 

LAilSlN 

ooocioci 

lF(ADS(fl!K&CLTl ,2) ) .OF. 100.0)  CALL  FRRMFS ( 9HC AMS , MiC AMSINt S, 1 ) 

CAhSIN 

ooo,eoi 

AR(..(2)2ClTKri(LtI,2) 

CAHSIN 

OOO^O'l 

iriAUStCHKHfLtI  ,2)  ) .OF.  1 00,0)  CALI.  F.RRHB  S ( 9HC  AMS  , 6HC  AHb  I N ,5 » 1) 

CAHSIN 

000205 

CUtI,  l)=CHK!;(L,I,l) 

cams  1 N 

000206 

Gf  JtI,,.0=rHKOCLf  1,2) 

CAHSIN 

00020/ 

tif  J,  I . 1 ) =CMKh(L  , 1,1) 

cahsiw 

00020U 

Hf  J,l,2)=niFHfl.rI,2) 

CAMSIN 

000209 

52 

CONTINUE 

CAHSIN 

000210 

51 

CONTINijF 

camsin 

00021  1 

50 

COnTIMuF 

camsin 

000,11  2 

Kl.TDRII 

camsin 

00021  3 

F.HD 

CAHSIN 
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FQi^t  IS  CAS 

SUBRUUTIME  CAS  t^AS 

MAIN  DRIVER  FOR  CAS  S’lMULATDR  CAS 

CAS 

ARGUMENT  LIST  FOR  ERROR,  PROCESSING  ARGLST 

COMMON  /ARGLST/  ARGLST 

1 NERRS  tMFATAL  »MPERRS  ,N-ARG  »ARG(10)  ARGLST 

DIMENSION  lARG(lO)  ARGLST 

EQUIVALENCE  ( 1ARG»ARG  ) ' ARGLST 

ARGLST 

‘ CAS  CONTROL  CARD  INPUT  DATA  AND  CONSTANTS  ..  CASCM 

COMMON  /CASCM  / CASCM 

1-  AREACF,YCF  »PRDCF  tAPRUTS(4,2)  ,PPRUTS(5,2)  ,YPRUTS(3,2)  CASCM 

2 ,AKEAPS,S2MAX  ,NHISTYtHH  »T0PT  , AUNI T S , D I ST F F , B WI NO ( 4 ) CASCM 

3 ,WPRIOR(4)  ' ,APREP  ,IPRD(3rl4)  , NPD ATE t PRDATE ( 14 ) CASCM 

INTEGER  HH,  TORT,  AUN I TS , D 1 STF F , B WI ND , WPR I OR t A PR EP , PRD AT E CASCM 

CASCM 

FLAGS  AMD  COUNTERS  FOR  CAS  SIMULATOR  ' CASFLG 

COMMON  /CASFLG/  ' CASFLG 

1 H tPPFLG  rNBW  ,IBW  , WINDOW, IPD  ,IPP  , P PD ATE , NREGS  CASFLG 

2 ,NZTUT  ,NSTRAT ,NYESSK tNSSHSK tNCAMSK ,NRYES  ,MRSSH  ,NRCAMS  CASFLG 

3 ,EMDC  ,EN0REG,END20N, IRSTR  , I RZON E , I RREG  CASFLG 

4 ,LDS1  ,L0S4  ,LDS7  ,LDS8  ,LDS9  ,LDS10  ,LDS11  ,LDSL2  ,LDS13  CASFLG 

5 ,LDS14  ,LDS]5  ,LDS]6  ,LDS17  , L RC OUN , L RRE G , LRZONE , LRSTR  ' CASFLG  > 

INTEGER  PPFLG  , WINDOW  , PPDATE  , CASFLG 

CASFLG 

CONTROL  PARAMETERS  FDR  LEM  PROGRAM  CNTRL 

COMMON  /CNTRL  / CNTRL 

1 PRIMTF  ,NSTART,SE6D( 7)  CNTRL 

INTEGER  PRIMTF  CNTRL 

DOUBLE  PRECISION  SEED  ■ CNTRL 

CNTRL 

CAS  DATA  SETS  1,2,  AND  3 , USETl 

COMMON  /DSETl  / ’ ' . DSETl 

1 ISUBST,TWAK  ,HWAK  ,EWAK  ,M1K  ,CT1K  ,ANALVK,EPW<  ,EPW2K  JULY76 

2 ,SMPKPI,SUMPK2,SUMPI<  ,KSlJB  ,NCLASS  JULY76 

REAL  MIK  , M2K  J0LY76 

DIMENSION  DSET1(14),  DSET2(14),  DSET3I6)  JULY76 

EQUIVALENCE  { DSET 1 ,DSET2 , 0SET3 , I SUBST  ) DSETl 

1 , •(  M2K,M1K  ),  { CT2K,CT3K,CT1K  ) DSET] 

C ' DSETl 
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C CAS  DATA  SETS  4,  5,.  AMD  6 (AT  STRATA  LEVEL)  DSET4 

COMMON  /DSET4  / DSET4 

1 STRATAtTWASI  tHWASL  ,EWAS1  ,XM1JS  tXCriS  ,ANVS1  JULY76 

2 tl'WAS2  tHWAS2  tEWAS2  ,XM2JS  t XCT2S  ,ANVS2  ,T  JULY76 

5 ,TWAS3 »HWAS3 »XCT3S 

4 ,XYS  »XESTYS,EVYRS  , P2 1 DPK , V 1 V2S  ,VARS  ,ANVAJRS  JULY76 

5 ,FILL4(57) 

lNTE(:.Ek  STRATA  JULY76 

DIMENSION  DSET4(24)t  DSET5(7)»  DSET6<3)  JULY76 

E(JUIVALENCE  ( DSET4,  STRATA  ),  { DSET5»TWAS2  ),  ( DSET6,TWAS3  ) DSET4 

DS6T4 

CAS  DATA  SET  7 (AT  ZONE  LEVEL)  DSET7 

COMMON  /DSET7  / , DSET7 

1 ZONE  tHWAZ2  ,EZ  , M 1 K2 K Z , AN AL V Z , NSTR AZ , H W AZ 1 ,EWAZ1  ,HWAZ3  JULY76 

2 tESTVZ  ,HWAZI2  JULY76 

3 tMlK2CL(10)  ,EPWCL(10)  ,EPW2CL(10)  ,PKPICL(10)  JULY76 

4 »PK2CL(10)  ,PKCL(10)  ,SSQ(10)  JULY76 

inte(;ek  Zone  july76 

REAL  MIK2KZ?  M1K2CL  vJULY76 

DIMENSION  DSET7(81)  JULY76 

ECOUIVALENCE  .(  DSET7,Z0NE  ) DSET  / 

DSET7 

CAS  DATA  SET  8 (AT  REGION  LEVEL)  DSET8 

COMMON  /DSET8  / . 0SET8 

1 REGION, HWAR2  ,ER  , M 1K2KR  , AN ALVR , NZONE S , H W ARl  ,EWAR1  ,ESTVR  JULY76 

2 ,M1M2ZR,FILL8( 71  ) JULY76 

integer  REGION  ' JULY76 

real  M1K2KR  JULY76 

DIMENSION  DSETBdO)  JULY76 

EOUIVALEMCE  ( OSET8, REGION  ) DSET8 

USET8 

CAS  DATA  SET  9 (AT  COUNTRY  LEVEL)  • 0SET9 

COMMON  /DSET9  / . 0S6T9 

1 CUUNTRtHWAC2  ,EC  , M1K2KC',  ANALVC,M1M2ZC,  HWACl  tEWACl  ,ESTVC  JULY76 

INTEGER  COUNTR  JULY76 

REAL  M1K2KC  t - JULY76 

DIMENSION  DSET9(9)  JULY76 

EOUlVALENCE  ( 0SET9tC0UNTR  ) USET9 

DSET9 

CAS  DATA  SET  10  (STRATA  DATA  — FINAL  PASS)  JULY76 

C(JMMOM  /DSET  10/  J0LY76 
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1 HWAS  tTWAS  ,FWAS  ,AERRS  , AVARS  t T P ROD S t E PRODS » P R ERRS r PR VARS  JULY76 

2 ,YS  tESTYS  ,YERRS  ,M1JS  ,M2JS  tCTlS  ,CT2S  ,CT3S-  ,ANAVS  JULY76 

3 ,AMPRVS,ES  ■ JULY76 

REAL  MIJS  , M2JS  JUI.Y76 

DIMENSION  nSET10(20)  ' . J0LY76 

EDUIVALENCE  ( DSETIO,HWAS  ) ' . ' • JULY76 

C DSETIO 

, C CAS  DATA  SET  11  (ZONE  DATA  — FINAL  PASS)  JULY76 

COMMON  /DSGTll/  • DSETll 

1 HWAZ  ,TWA2  ,EWAZ  ,AERRZ  ,AVARZ  t TPRDDZ , EPRODZ , P RE RR Z , PRVARZ  DSETll 

2 ,TYZ  ,EYZ  ,YERRZ  ,M1Z  »M2Z  tCTIZ  ,CT2.Z  ,CT3Z  ,ANAVZ  DSETll 

3 tANHkVZ  - DSETll 

REAL  MIZ  f M2Z  DSETll 

DIMENSION  DSETIKIV)  DSETll 

equivalence  { 'DSETll »HKAZ  ) DSETll 

C DSETll 

C CAS  -DATA  SET  12  (REGION  DATA  — FINAL  PASS)  v)ULY76 

COMMON  /DSET12/  DSET12 

1 HWAR  rTWAR  ,EWAR  ,AERRR  ,AVARR  ,TPR ODR , E PRODR » PR ERRR t P RVARR  DSET12 

2 tTYR  ,FYR  ,YERRR  ,M1R  ,M2R  ,CT1K  ,CT2R  ,CT3R  ,ANAVR  DSET12 

3 jANPKVR  . DSET12 

REAL  MIR  , M2R  DSET12 

DIMENSION  DSET12(19)  DSET12 

EQUIVALENCE  ( DSET12,HWAK  ) . DSGT12 

C ■ DSETI2 

.C  CAS  DATA  SET  13  (COUNTRY  DATA  — FINAL  PASS)  JULY76 

COMMON  /DSET13/  DSET13 

1 HWAC  tTWAC  ,EWAC  »AERRC  ,AVARC  »TPR0DC,EPR0DC,PRERRC,PRVARC  DSET13 

2 ,TYC  ,EYC  ,YERRC  ,M1C  ,M2C  tCTlC  ,CT2C  ,CT3C  , ANAVC  DSETIB 

3 » ANPKVC,CLFWA  , CL EPRD t CL ATEC , CLPTE C , CL ATWC , CL PT WC  DSET13 

REAL  MIC  , M2C  DSET13 

DIMENSION  D5ET13(25)  DSET13 

EQUIVALENCE  ( DSET13,HWAC  ) DS6T13 

C DSET13 

C INDEX  RECORD  FOR  CAS  INTERMEDIATE  DATA  SET  FILE  (CASOSF)  IXCDSF 

COMMON  /IXCDSF/  IXCDSF 

1 IXCnSF( 1 ) ,LIXCDS 

C '•  , IXCDSF 

C LEM  CONTROL  CARD  INPUT  DATA  LEMCM 

COMMUN  /LEMCM  / LEMCM 

1 TITLE(IO)  tICASE  , CUNT R Y tNTR I AL f RST ART , I PR  I NT , ST ARTR , ST ART Z LEMCM 
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2 tENOK  tEiMDZ  tISTG  ,ICAMS  »IYES  rIACQ  , I CLASS , I S EXT  , I SCC  LEMCM 

3 »ICAS2  ,ICAS3  , I PRC AM , I PRY ES , 1 PKC AS , I C SE SG» I CSEC W, I CS ES H , I CS ECE  LEMCM 

• 4 , ICSEYM,ICSESe,ICS6ACtRSEEDl»RSEED2,RSEEn3,RSEED4,RSEED5TRSEED6  LEMCM 

5 »RSEED7, ICSESTt ICSECn, ICSEYS, ICS6CU, ICSECD  LEMCM 

DIMENSION  RSEED(7)  . LEMCM 

DOUBLE  PRECISION  RSEED  t RS EEDl , RSEE D2 , RSE E D3 » RSE€D4 , RS EED5  LEMCM 

1  ,RSEE06 »RSEE07  LEMCM 

EQUIVALENCE  ( RSEEDtRSEEDI  ) LEMCM 

INTEGER  RSTART tSTARTRrSTART Z , ENDR  ,ENDZ  LEMCM 

LEMiCM 

SEGMENT  oAtA  FROM  CAMS  OUTPUT  FILE  (CAMSF)  . SEGDTA 

CUMMUM  /SEGDTA/  SEGDTA 

1 IDSEGT(5)  rISEG  ,TPWKI  ,ZACOAY(4)  ,EPWKI(4)  SEGDTA 

2 fERRHWlU)  ,ESTPWI  S'EGDTA 

integer  ZACDAY  SEGDTA 

'SEGDTA 

SUBSTRATA  HISTORICAL  DATA  FROM  SU6HST  FILE  SSHDTA 

CUMMIJN  /SSHDTA/  ' SSHDTA 

1 COUN2  tIREG2  ,IZUNE2tISTRA2,ISUBS2,NSEG  rIDSEG  ,GRPNO  ,HISTPW  SSHDTA 

2 ,AREAK  ,PWK  ,NAGR  »NA  , D EL  TP W t D ELT PM , C V 1 tCV2  tCV3  SSHDTA 

3 tCV4  , VMULTK, class ( 18 ) ,MXK tRDSSH  JULY76 

INTEGER  GRPNO  , CLASS  t RDSSH  JULY76 

DIMENSION  SSHDTA (39)  JULY76 

EOUIVALENCE  ( SSHDTAt  C0UN2  ) SSHDTA  ' 

SSHDTA 

STATISTICAL  INFORMATION  FOR  LEM  STATS 

COMMON  /STATS  / STATS 

1 ITER  iMSEGTRtNCAMSRtNYESR  , NREC  ( 7 ) , NCA-SCR  t NC  ASDR  STaTS 

EOiJIVALENCE  ( NT,  ITER  ) STATS 

stats 

SUMMARY  DATA  FOR  REPORTS  SUMDTA 

COMMON  /SUMDTA/  SUMDTA 

1 CVAEPT  ,CVEPTA,SDPER  ,CVPEPT  ,CVEPTP  ,CSl)MR  { 18, 18  ) SU(’'iDTA 


SUMDTA 

YIELD  DATA  FROM  YESOUT  FILE  YESDTA 

COMMON  /YESDTA/  YESDTA 

1 YSTR  ,IZPRDD(6)  ,YSCI(6)  ,VSYCI{6)  YESDTA 

•‘2  ,RDYES  ,I\1YESPP  YESDTA 

INTEGER  RDYES  YESDTA 

YESDTA 

CAS 
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C PERFORM  PROGRAM  INITIALIZATION  TASKS  CAS 

CALI.  CASINT  ■ CAS' 

IF  ( NFATAL  .NE.  0 ) GO  TO  900  CAS 

C ■ CAS 

,C  BIOWINDOW  LOOP  CAS 

IBW=  0 CAS 

2X0  I3W=  IBW  + L CAS 

IF  ( BWlNOdBW)  .EO.  0 > GO  TO  250  CAS 

C PROCESS  NEXT  8I0WIND0W  CAS 

CALL  CASPP  . . CAS 

IF  ( NFATAL  .ME.  0 ) GO  TO  900  CAS 

250  IF  ( IBW  .LT,  4 ) GO  TO  210  CAS 

' CAS 

PREDICTION  DATE  LOOP  CAS 

300  PPFLG=  I ' CAS 

IPD=  0 CAS 

310  IPD=  IPD  + I CAS 

PPDATE=  PkOATE(IPD)  ' CAS 

IF  { PPDATE  ,EQ.  0 ) GO  TO  400'  CAS 

PROCESS  NEXT  PREOICTION  POINT  CAS 

CALL  CASPP  CAS 

IF  ( NFATAL  -ME,  0 ) GO  TO  900  CAS 

IF  ( IPD  .LT.  NPDATE  ) GO  TO  310  CAS 

CAS 

WHEN  PRINTF  .ME.  0,  PRINT  COUNTRY  SUMMARY  REPORT  CAS 

400  IF  { PRINTF  .NE.  0 ) CALL  SUMREP  CAS 

900  RETURN  CAS 

END  • CAS 
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OOOOOl 

BLOCK  data  CASBLO 

CASDLO 

000002 

c 

casbld 

000003 

c 

FLAGS  AND  CoULTtRS  FoR  CAS  SIHULAIOR 

> 

casflk 

oooooo 

CfiMMON  /CASfLC/ 

CAbFLG 

00  0 o'o  b 

1 H f-FPPLG  jNtiU  ,inw  ,WlNDfih,lPD 

f IFP 

tPPOAlEfNREGS 

tAbnc 

000006 

P.  »M/TqT  tNSrRAT.NVFSSK,NSSHSK,MCAHSKrNRYrS 

fNHSSH 

tNRCAKS 

CAbFLG 

000007 

3 iFNDc  tENt)RM;frNOZnN,lH5'TR  t JK/ONt  t IRRFG 

CAbn.G 

ouoooa 

4 ilDSl  ,LDS4  tLUS7  ,Lns«  .LOSV  tLDSlO 

tLDSll 

tLDSlS  .LDS13 

casflf- 

000000 

5 tlOSl'J  fLDSiS  fUlSlO  ,LDS17  t L RCOU.N  t LRRt  G 

tLhZONEtLRSTR 

casflr 

0 0 0 0 ! 0 

INTMltK  PI'FLG  » WiNDOH  t Rf’DATt 

casflg 

OOOOtl 

. . 

CASFlG 

000012 

c 

. IMDFX  RtroKO  M‘R  CAS  1 N T ERMhDI A 1 F DATA  SfT  PILF 

(CAbObF) 

IXCDSF 

0000  1 3 

LomniM  /ixcosF/ 

IXCOSF 

000014 

1 IXfi)SK(  1)  rLIXCnS 

IXCOSF 

0 0 0 0 1 '3 

c 

iXLObP 

00001  6 

c 

CA3(H,D 

0000  1 7 

DATA  LiXCOS  / 3H8  / 

CAbULO 

OOOOlti 

c 

CASiiLO 

000019 

fcND 

CAsnuo 
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o fLT  CASi:Rl,it760«27f 


000001 

00000^ 

000005 

oooooo 

OOOOOS 
000006 
000007 
000006 
000009 
00001  0 
0(1001  1 
noooi  2 

000013 

0000  I 0 
OOflOlS 
0000  1 6 

00001  I 
000015 
0000  1 V 
oooo?o 
nooopi 
000022 
000025 
000020 
00002S 
000026 
00002/ 
000025 
000029 
OOOO'IO 
000031 
000032 
0000  S5 
00003/1 
0 00  0 3'j 
00003O 
00003/ 
000tt35 
0 0 0 0 3'? 
0000/10 
ooou/u 
oono/12 

000005 
0000/14 
0000/li) 
0000/46 
000007 
000005 
OOOO'tV 
OU00‘’O 
OOOoM 
/lilO()>,2 
000065 
OllOoSO 
000066 
0 0 0 (1 S 6 
0 li  (1 0 'I  / 

000065 


c 

c 

c 

c 


c 

c' 


c 

c 


c 

c 

c 


SiniROIlTlNF  fASt'RKiNO) 

THIS  SHoROUTlNF  rOUTAU’S  THE  IHPtlT  EHROR  HESSAGES  FUR  CAS 

argument  list  FljR  ERROR  PROCFSS-ING 
COMMON  /ARC-LST/ 

1 MfcRRS  .NFaTAI.  fNPFKRS,NAKG  tARG(lO) 

DIMENSION  UHG(IO) 

EOOIVALf  NCE  ( TaR(;>ARG  } 

CAS  CUMTROl-  CARO  INPUT  DATA  AND  CONSTANTS 
COMMON  /rA'tCll  / 

1 ARFaOF.VCF  fPROCF  , Af'riUT  S C 0 1 2 ) tPPRUTS(6,2)  lYRRlJl  S(3»2) 

?.  t ARfAPStSPRAX  fNHTSTYfHM  »TOPT  ? Al!N  I TS » 0 1 S T FF  f UR  I'll)  C 4 ) 

3 fNPRinR(4,t  tAPREP  fIPRri(3*lin  tf/POAtf  tPROATEd/l) 

IMThGFR  HiU  TOPTf  AON  ITS » D 1 ST PF , 0 H I NO t RPR  I OR* APRF P i PROAT F 

FII  E ‘OmNn  TOMS  AMO  KFCORI)  LENGTHS 
COMMON  /fills  / 

1 SEGfO  tLSf GIOrCROPw  , LOROPW t SOPHS  1 , LSUPH  .ACPUTStEACO 

2 tCAMsF  ,LCAKSFfCAMERR,LCAMfP,CASF  .LCASF  t YL50U I .LYESO 

3 tSIGtX  l,ESJGEX»YE5E'RR.LYESERf  SECIRUtLSL  G1  R » C AS()  I S * LC  ASO 

4 tIHP  ‘tOin.P  tlACU  .LTaCO  tCASUSl  *LCAS0S 

IMTFGFR  SLGIO  iCROPR  i SOS'hS r i ACuUI S i C A^Sf  tCAMfRRiCASF  tYESOUT 
1 fSIOFxT  »Yt.SERR*bFOTRUirASOlStOH?P  »TACN  fCAST/SF  • 


GO  TO  (10»20f3o»40f60,60i70)tlN0 
10  CONTlnuF 

WRITEfo'lTPt  1000)  lARGd)  iTARGtd) 
Rrll.iRM 
2.0  CONTIMUF 

PRITI  (oliTPr2000)  NHISTY 
RETURN 
30  COMTINIJF 

hRITI  fi)l)TPt3000)  HH 
HH=  99<?99 
RF  TURN 
40  CONTINUE 

HRnhtOl'TP»'*00O)  RPKIOR 
RFllIRR 


50  COtiTlNuf 

RRlU  foHTPiSOOO) 

RF  TURN 
60  CONTlfuF 

RHnL(oUTP»6000)  |ARGd),IARai2)  *IARG(3)  tIARG  (I  ) 1 1 ARG(2)  , 1 ARG(  3) 
RnilRN 


70  CONTIMUF 

F.RlTL(nUTPi7000) 
Rl TURN 


1000  hORHATfPX, 

r 5/MIlspROPE'R  LADEL  AND  SEOUFNCE  NUMBER  ON  A CAS  CONTROL  CARD, 
1 /2X,21HLA!1EI  and  SEO.  NO,  = ,A4t2XtI2) 

2000  FORMAT  (2X,VHNllI!ilY  = ,I3fl/H  IS  OUT  OF  RANGF  , i 
t /2Xt2?|id  ,11.  MuISTY  ,LL.  20)  ) 

3000  T DRMAT  (2X,61IHM  ::  tMdOM  !S  OUT  OF  RAUOF 
1 /2X-l''ll(i  ,1-E*  >ltl  ,1  E.  ’)V)  ) 


CASFRl 

CASEKl 

tASFRl 

LASFkl 

AKOl.sT 

A P gist 
ARgLST 
APGt  sT 

arglst 

APOl ST 

CASCM 

CASr.H 

t ASCH 

CASCM 

CASCft 

CASCM 

CAiiftl 

f ILFS 

f H.FS 

F ILFS 

KU  FS 

FILES 

FU  FS 

F U FS 

FILES 

F ILFS 

CASFHI 

CAsFkI 

CASFRl 

CASFRl 

CASFRl 

CARFSl 

LASF|;1 

CAbFRl 

CAS! hi 

lasfri 

CASFRl 

CASF  Rl 

CASFRl' 

CASFRl 

CASFRl 

CASFRl 

C-'SFrI 

CASFRl 

CASFRl 

CASFRl 

CAsFhI 

CASFRl 

CASFRl 

CASFRl 

CASFRl 

CASl Rl 

CASFRl 

LASFHI 

CASl Rl 

OASFrI 

CASl Rl 

CASFRl 
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OODOS9 

000060 

000061 

000062 

00006i 

oooooq 

00006b 

000066 

000067 


0000  60HKA7  (?X,37(llLLt.(:At  WINDOW  bPtOIFIEO  IN  WPIUOK  = t 

1 )^Il  /2X,^0HC6ACM  window  MUST  BP,  t-0  OP  0)  ) 

Sooo  FOKHAI t?X,30HALt.  FNTKILS  IN  WPKIOR  APK  7t«U  > 

6000  Ff)KllAT(PXt2'tHTUL0Ai.  PRrUICTION  DAU  » 2(  12»  IH/;  t I2i  IIH  SPECIPItD, 
' 1 /?Xf7liyrA«  = »l?f26HHUbT  op  .op.  60,  iiUNTh  = 

1 I2,?lM  MUST  OF  I~12,  OAY  = tIPflOH  MUSI  l)F  1-31.  ) 

7000  FOPHAT(?X, 

• 1 53tlP.'i[,01t:TION  PATPS  not  in  ASOKNDlNli  OROD’i  OR  DUPPICAIES  ) 

pNl) 


CASFRl 
PASFRl 
OASFRl 
PABPRt 
CASFkI 
CA5FR1 
CA6FR1 
CASf Rt 
CAS! Rl 
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oo  oo  n oo.  ooo 


t-UR,IS  CASER2 

SUBRUDTIME  CASEK2  (ICODE)  CASER2 

PRINTS  PROCESSING  ERROR  MESSAGES  FOR  CAS  SIMULATOR  CASER2 

CASER2 

ARGUMENT  LIST  FOR  ERROR,  PROCESS ING  ARGLST 

COMMON  /ARGLST/  ARGLST 

1  NERRS  tNFATAL tMPERRStNARG  ,ARG(10)  ARGLST 

DIMENSION-  lARG(lO)  . ARGLST 

EQUIVALENCE  ( lARG^ARG  ) ARGLST 

ARGLST 

Flags  and  counters  for  cas  simulator  . • casflg 

COMMON  /casflg/  C'ASFLG 

1 H tPPFLG  ,N8W  tIBW  ^WINDOWtIPO  »IPP  , P PD ATE t NREGS  CASFLG 

2 ,NZTC)T  TNSTRATtNYESSK»NSSHSK'»NCAMSK,NRYES  ,NRSSH  ,NRCAMS  CASFLG 

3 »ENDC  ,ENDREG»EMDZ0N, IRSTR  t I RZON E , I RREG  CASFLG 

4 tLDSI  ,LDS4  ,LDS7  ,L0S8  ,LDS9  »L0S10  ,LDS11  ,LDS12  ,LDS13  CASFLG 

5 ,LDS14  tLDS15  ,L0S16  ♦LDS17  t L RCOUN  , L RRE  G , LRZ  ONE , L RSTR  CASF.LG 

INTEGER  PPFLG  , WINDOW  , PPDATE  CASFLG 

casflg 

COMMON  /DSET4  / STRATA  CASER2 

COMMON  /DSET7  / ZONE  CASER2 

COMMON  /DSETB  / REGION  . CASER2 

INTFGER  STRATA,  ZONE,  REGION  . CASER2 

' CASER2 

FILE  DEFINITIONS  AND  RECORD  LENGTHS  FILES 

COMMON  /FILES  / FILES 

1 SEGID  ,L  SEG  lOtCROPW  ,LCROPW,  SUBHST,LSUBH  ,AC(0UIS,LACQ  FILES 

2 tCAMSF  ,LCAMSF ,CAMERR ,LCAMER ,CASF  ,LCASF  , YESOUT ,LY ESO  FILES 

3 ,S1  GEXTtL  SIGEX,  YESERR  ,LYESER,SEGTRU,LSEGTR,CASt)lS,LCASD  FILES 

4 ,INP  tOUTP  ,TACO  ,LTACO  ,C ASDSF ,LCASDS  FILES 

INTEGER  SEGID  ,CROPW  , SUHHST , AC  00 1 S , CAMSF  ,CAMERR,CASF  , YESOUT  FILES 

1 ,SIGEXT, YESERR, SEGTRU,CASOIS,OUTP  ,TAC«  ,CASDSF  FILES 

files 

LEM  CONTROL  CARD  INPUT  DATA  , LEMCM 

COMMON  /LEMCM  / LEMCM 

1 TITLEdO)  ,ICASE  , CUNTRY  , MTR I AL  ,R  ST  ART  , I PR  I NT  , ST  ARTR  , ST  ART  Z LEMCM 

2 ,ENDK  ,EMf)Z  ,ISTG  ,ICAMS  ,IYES  ,IACO  , I CL  ASS , I SE  XT  ,ISCC  LEMCM 

3 ,ICAS2  ,ICAS3  ,IPRCAM,IPRYES»IPRCAS,ICSESG,ICSECW,ICS6SH,ICSECE  LEmCM 

4 ,ICSEYM, ICSESE, ICSEAC,RSEED1, RSEED2, RSEED3, RSEED4,RSEED5,RSEED6  LEMCM 

5 ,RSEED7,ICSEST,ICSEC0,ICSEYS,ICSECU,ICSECD  LEMCM 

DIMENSION  RSEED(7)  LEMCM 
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' DUUBLE  PRECISION  RSEED  , RSEEDl , RSE6 02 ♦ RSEED3 t RSE ED4 , RS EED5  LEMCM 

1 tRSEED6  ,RSEE07  LEMCM 

EOU I VALENCE  ( RSEED, RSEEOl)  LEMCM 

INTEGER  RSTART ,STAKTR,STARTZ, ENDR  ,£NDZ  LEMCM 

C LEMCM 

C SUBSTRATA  HISTORICAL  DATA  FROM  SUBHST  FILE  . SSHDTA 

CUMMUN  /SSHDTA/  • SSHDTA. 

I’'  C0UM2  ,IREG2  , 1 Zf)NE  2 , I ST  RA2 , 1 SU  BS2  , NS  EG  ,IOSEG  ,GRPNO  ,HISTPW  SSHDTA 

2 ,AREAK  ,PWK  ,NAGR  ,.NA  , DELTPW , DELTPM,  CVl  ,CV2  ,CV3  SSHDTA 

3 tCV4  tVMIJLTK,CLASS(  18)rMXK,RDSSH  JULY76 

INTEGER  GRPNO  , CLASS  , RDSSH  . JUI.Y76 

DIMENSION  SSHDTA (39)  JULY76 

EUUIVALENCE  ( SSHDTA,  C0UN2  ) SSHDTA 

C SSHDTA 

C SEGMENT  DATA  FROM  CAMS  OUTPUT  FILE  (CAMSF)  SEGDTA 

COMMON  /SEGDTA/  ‘ SEGDTA 

1 IDSEGT(5)  fiSEG  ,TPWKI  ,ZACDAY(4)  ,EPWKI(4)  SEGDTA 

2 ,ERRPWI(4)  ,ESTPWI  SEGDTA 

INTEGER  ZACDAY  SEGDTA 

C SEGDTA 

C CASER? 

DATA  MXMES  / 19  / ’ JULY76 

C ‘ CASER2 

C CASER2 

IMES=  ICUDE  CASER2 

IF  ( IMES  .LT.  1 .OR.  IMES  .GT.  MXMES  ) GO  TO  800  CASER2 

C CASER2 

GO  TO  ( 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 110, 120, 130,140, ISO'rlBO, 170  CASER2 
1 ,180,190)  , IMES  v)ULY76 

C CASER2 

10  WRITE  (nUTP,l)  IARG( 1 ) , ARG(  2 ) CASER2 

1 FORMAT  (3RH0DIVISIGN  8Y  ZERO  MOT  ALLOWED.  EON.  (,I3,4H),  ,A6,  C'''=FR2 

1 5H  = 0.)  CASER2 

GO  TU  900  CASER2 

C CASER2 

20  WRITE  (0UTP,2)  ' CASER2 

2 FORMAT  (105H0IF  NT  = 1,  VARIANCE  ERRORS  AND  CONFIDENCE  LEVELS  CANNCASER2 

lOT  BE  COMPUTED  AND  WILL  BE  ARBITRARILY  SET  TO  ZERO.)  ’ CASER2 

GO  TO  900  CASER2 

C CASER2 

30  IARG(2)=  STARTR  CASER2 
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o O 


40 

4b 

4 


C 

bO 

'60 

65 

6 


70 

7 


C 

80 

8 


C 

90 

9 


C 

100 

910 


C 

110 

11 


GU  TU  45  . . CASER2 

IAR6(2)=  STARTZ  ' CASER2 

WkJTE  (0UTPt4)  ARGd  )t  IARG{2)tARG(3  ) CASER2 

FORMAT  ( lOHOSTARTi MG  ,A6»I5t15H  NOT  FOUND  ON  A6,6H  FILE.)  CASER2 

GO  TO  900  . CASER2 

CASER2 

IARG( 2)=  EMDR  . CASER2 

GO  TO  -65  CASER2 

IARG(2)=  ENDZ  CA'SER2 

WRITE  (0UTPt6)  ARG{l)»IARG(2)tARG(3)  CASER2 

FORMAT  (BHOEND.ING  .A6,I5tl5H  NOT  FOUND  ON  ,A6,6H  FILE.  ) CASER2 

GO  TO  900  CASER2 

CASER2 

CASER2 

WRITE  lOUTPtT)  - REGION,  ZONE,  STRATA,  NRYES  GASER2 

FORMAT  (49.H0ZER0  PREDICTION  DATES  ON  YESOUT  FILE  FOR  REGION  ,14  CASER2 

1 ,7H,  ZONE  ,14, 9H,  STRATA  ,I4,15H  {DATA  RECORD  ,I4,1H))  CASER2 

GO  TO  900  • CASER2 

' CASER2 

WRITE  (0UTP,8)  GRPNO, IREG2, IZ0NE2, ISTRA2,! SUBS2,NRSSH  CASER2 

•format  (22H0ILLEGAL  GROUP  NUMBER  ,I3,30H  FROM  SUBHST  FILE  FOR  REGCASER2 
IION  ,I4,7H,  ZONE  ,I4,10H,  STRATUM  ,I4,13H,  SUBSTRATUM  ,14  CASER2 

2 /15H  (DATA  RECORD  ,14, IN))  CASER2 

GO  TO  900  . CASER2 

CASER2 

WRITE  (0UTP,9)  NAGR ,NA, GRPNO  CASER2 

FORMAT  (BHOMAGR  = ,I4,10H  OR  NA  = ,I4,42H  -FROM  FILE  SUBHST  ARE  CASER2 
IZERO.  GROUP  NUMBER  ,I3,17H  IS  CHANGED  TO  3.  ) CASER2 

GO  TO  900  • CASER2 

CASER2 

WRITE  { 0UTP,910)NRYES,REGI0N,Z0NE, STRATA,NRSSH,IREG2, IZ0NE2, ISTRA2CASER2 
FORMAT  ( 47H0INC0NSISTENCY  BETWEEN  YESOUT  AND  SUBHST  FILES.//  CASER2 

1 «X,30HREC0RD  region  zone  STRATA/8H  YESOUT  ,15,318/  CASER2 

2 «H  SUBHST  ,I5,3IB)  CASER2 

GO  TO  900  CASER2 

CASER2 

WRITE  (OUTPjlL)  NRSSH, I KEG2 , I ZON E 2,  IS TR A2 , I SUBS2 , NRCAMS , I DS EGT ( 2 ) C ASER2 
1 , IDSEGT (3 ) , IDSEGT(4  ) , IDS6GT ( 5 ) CASER2 

FORMAT  (46h6imC0NSISTENCY  BETWEEN  SUBHST  AND  CAMSF  FILES.//  CASER2 

1 8X,41HREC0RD  REGION  ZONE  STRATA  SUBSTRATA  CASER2 

2 /8H  SUBHST  , 1 5 , 3 1 8 , 1 1 0 / 8H  CAMSF  ,15,318,110)  . CASEK2 
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GO  TO  900  CASER2 

C ' CASER2 

120  WRITE  (OUTPilZ)  lARG(l)'  CASER2 

12  FORMAT  ((SIHOERRGR  RETURN  FROM  BETA  DISTRIBUTION  SUBROUTINE.  ERROR  CASER2 

IFLAO  = 13)  ' CASER2 

GU  TO  900  ' ■ ' CASER2 

C CASER2 

. 130  WRITE  (0UTP,13)  I SUB S2 , I S T R A2 , I Z0NG2 , 1 R E G2 t NR SS H CASER2 

13  FORMAT  {26H0N0  SEGMENTS. IN  SUBSTRATA  STRATA  ,I4,7H,  ZONE  CASER2 

1 14, 9H,-  REGION  I4.17H  (SUBHST  RECORD  ,I4,iH))  ' CASER2 

GO  TO  900  . CASER2 

C CASER2  ■ 

140  WRITE  (0UTP,14)  CASERz 

14  FORMAT  ( 52H0ZER0  OR  NEGATIVE  DIVISOR  IN  COMPUTING  TAU2S,  SIGM2S/  CASER2 

1 14HIE0S.  93D-93F)  ) ' CAS6R2 

GO  TO  900  . CASER2 

C ■ CASER2 

150  WRITE  (0UTP,15)  H I STPW, I SUBS2 > I STRA2 , I Z0NE2 , IREG2  CASER2 

15  FORMAT  (22H0WARNI'NG- . . HIST  PW  =F6.2,16H  FOR  SUBSTRATA  ,14  CASER2 

1 ,9H,  STRATA  ,I4,7H,  ZONE  ,I4,9H,  REGION  ,14/  CASER2 

2 24H  GROUP  NO.  CHANGED  TO  3.)  CASEK2 

GU  TO  900  CASER2 

C CASER2 

160  WRITE  (DUTP,16)  I PD  , PPD AT 6 , STK AT A , ZQ NE , R EG  I ON , MR YE S . CASErZ 

16  FORMAT  (24H0IMPUT  PREDICTION  DATE  (,I2,4H)  = 14/  CASER2 

1 54H  .LT.  ALL  PREDICTION  DATES  ON  YESOUT  FILE  FOR  STRATA  ,14,  CASER2 

2 7H,  ZONE  ,I4,9H,  REGION  ,I4,10H  (RECORD  ,I4,1H))  ' CASER2 

GO  T(1  900  CASER2 

1/0  WRITE  <0IJTP,17)  CAS6R2 

17  FORMAT  (5BH0T00  MANY  MONTE  CARLO  ITERATIONS  FOR  CAS  DISTRIBUTION  CASER2 

IFILE  ) CASER2 

GU  TO  900  C''^FR2 

C CASER2 

180  WRITE  (0UTP,18)  AR  G ( 1 ) , I ARG  ( 2 ).,  ARG  ( 3 ) » ARG  ( 4 ) CASER2 

18  FORMAT  (2H0  ,A6,9H  IN  EO.  ,I4,3H  = ,E13.6,15H  REF.  VALUE  = , ' CASER2 

I E13.6)  CASER2 

GO  TO  900  ' . CASER2 

C ‘ , CASER2 

190  WRITE  (0UTPa9)  I ARG  ( 1 ) , Z ONE  , R EG  I ON  , I ARG  ( 2 ) JULY76 

19  FORMAT  (40H0LESS  THAN  2 ACCOUIRED  SEGMENTS  IN  CLASS  13, 9H  OF  ZONE  JULY76 

1 14, 8H  REGIONf  I4',?AH.  NO.  OF  ACO.  SEGMENT$=I3)  jULY'/6 
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GO  TU  900 


C 

c 

ttOO 

801 

900 


WRITE  (0UTP,801  ) IMES 

FORMAT  (59H0  SUBROUTINE  CASER2  CALLED  WITH 
ICOOE  ,14) 

RETURN  ' 

END 


JULY76 
JULY 76 
CASEK2 
CASER2 

ILLEGAL  ERROR  MESSAGE  CASER2 

CASER2 

CASER2 

CASER2 
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f>  .Fi^CASINtl,760it?7.  biZHZ  » 1 


000001 

0OO002 

000005 

000000 

00000b' 

00O006 

ouooo  7 
000008 
000009 
0000  1 0 
00001  I 
OOOOU 
OOOO  1 5 
0000  10 
00001b 
000016 
000(11'/ 
000018 
000019 
01/0020 
000021 
000022 
000025 
000024 

000n2b 
000026 
00 002/ 
000 028 
00002V 
000050 
000031 
0000  32 
000035 
000034 
00005b 
O000'36 
00003/ 
000038 
000039 
(100040 
000041 
000042 
000045 
00 OO 44 
000045 
00004O 
0 0 0 0 4V 
000048 
(1110049 
OOOObO 
IMIOOM 
000052 
000055 
000054 
00005b 
000056 
00005  / 

0 001)58 


c 

c 

c 

c 


■■  c 


c 

c 

c 


c 

t 


c 

c 


c 

c 


c 

c 

c 

c 


SUURUUTINF  CASIM  CASIN 

CASTN 

■THIS  SUPkOUTINE  HEADS  IM  AND  CHECKS  THE  CAS  CONTROL  CARDS  • CASIN 

LA&TN 

AKCuHLNT  list  for  error  PHOCFSSING  • AI'GLST 

COMMON  /AHOLSr/  ahclst 

t MLHRS  rNlATALf  NHEKRS,NAHG  lAKGllO)  AK'GLST 

DIMENSION  lARG(lO)  ’ • AHGI  ST 

EOUTVAtFNCC  ( lARGfAPG  ) ' AHGI.ST 

ARGLST 

CAS  control  card  input  data  and  CONSTANTS  ' CASCM 

COHUUN  /CASCH  / > (.ASCM 

1 ANOACftTCr  .PliOCF  f APKU 1 3 ( 4 , ?)  t PPH II T S ( 5 1 2 ) tYPKyTS(3»2J  LASCH 

2 rAKF  aI’5»S?MAX  »N|II3TY,I(H  «T0PT  t AUn  1 T S » 0 IS  IFF  , BH  1 NO  (4 ) CAsCM 

3 ri(HHir)l((n;  tAPREp  tIPRO(3fl4)  tNPDAtf  ,PHr>ATfc(  14)  CASCn 

1NIPG(-h  HH.  TOPTt  AlVNlTSrUISTFFjOhlNDtHPRlOH,  APRFPtHHDATE  CASEm 

t ASEM 

DATA  blUCK  FOR  C AS ; CljMUl  A T I VF  FILL  CASEuM 

CAS  DATA  Si  fS  I4»  jb,  16*  AnD  1/  ' CASCUH 

COMMON  ,/EASCD«/  LASCUM 

1 CAS(;IIH(52)  * MUFHJ(50  4)  LAseuM 

dimension  TCA6C(32)t  UStT14(22),  USLTlb(22).  DSfcTl6(22)  CASCIJM 

1 *DSf I I 7(28)  LASCUH 

EOUJVAlFNCE  ( ICASCtCASCUH  ) LASEuH 

tOUlVAuFNE.E  ( l)SEn4,DStIib,DS&Tl6,D5ETl7*CASCUM(b)  ) CASCUM 

1 * ( sOAf  RStGOALH/!  fSrArRRrSUAtRCfCA6CUM(241  ) tASEuM 

2 * ( SOPP  RStSOPl  P./*5nl‘pRR*S{jPLI!C*CA3a;MC2b)  ) CASEU--1 

3 * ( f,OYl  RS,S()Y(  R/,rSOY(  RR,SiJYLHLtCAoCUM(26l  ) - CA:,EuH 

LASCUM 

data  81 OCK  tor  las  UtSTKIBUTION  fill  (DATA  SET  19)  CAsnsH 

OIMFN'i]()N  CAS0StK505)  CASDSfl 

fcOUIVALfUCt  ( CASDSH.IltlFFK  ) • CASDSH 

DlIlFNSinN  ICAS0(505)*  H’/.'A2K  (60)  . HAKHFYC60)t  P1K(60)  CASDS8 

fcOOTiVAlJNCL  ( ILASI)*HWa2K|CASDS8  )»  { H AKNF  Y t C A5DS8  ( 6 1 ) ) LASDsH 

1 1 ( pik,casd:.iuI21)  ) . . casdsh 

CASN58 

nit  D!  UNIT  TUNS  AND  HFCORD  I LNGTIIS  . ' tllFS 

COMMON  /F1U5  / FILES 

1 SLEID  ,LSt8  lO.CROPW  , L CR  OpW  , SU8HS  T * LS08H  t ACOU  T S t L AC  T MLTS 

2 iFaMsF  tLCaM'IF  ,CANlRR,l.EAMlHff.ASF  .LCaSF  * YLSON  T * L YLSD  ‘ fiLlS 

3 jSlGtXI *LSIGt,X* Yt5tRK,LYtStRtSLGlRU,LStGlK*CASDIS,LCASD  F ILFS 

4 tINP  *0(ITP  tTACU  ,LTaC1j  * C ASDSF  * L E ASDS  MLFS 

INlH/lR  SiE.lD  *LRi/i’W  fSUMliS  ( * ACiJUISjEAMSF  iCAMFRRfCASF  tYfSnUT  FTlFS 

1 *STOrxTtYtSLRll*SbGTRll*CASDlStUUJP  *TACU  *CAfaDSF  MLFS 

FTLFS 

DATA  bl  OCK  fOR  CAS  UTSlHlbUTlON  Flit.  • IXDISF 

COM  ION  /IXDISF/  • • IXDISF 

1 TXDiSF(  n,'LIXDlS  , IVDisF 

NUTl,...  506  ONLY  AlLO'nS  UP  TO  8 PHtDlLHON  POINTS  INCLUDING  IV[>TSF 
"IOvifNOu'23  ( b06  = I t 1 t 8*63*  INDFX  + liFADtH  + 8 PRED,  PIS.liXOTSF 

IXDlsF 

I LM  (onihul  card  Input  daia  lfmcm 

COMKUN  /(LKcH  f ' LlMCH 


1 TITlKIO)  jICASF  ,LUNTRy,NTRIALtR5TART»  iPRlNTfSr.ARTRiSTARTZ  lfmcm 

2 *FNri>  thM|)7  *1310  ,JCAMS  *IYFS  *IACO  * ICt  ASS  * is'l  X T tISCC  LFMCM 

3 »ICA})2  tlCASl  , IPRCaM,  IPRYLS*  TPRCAS*  lESt  SC*  TLSLf^-.  ICSFSHi  ILStCt  I F MCM 

4 *.l(,si  Yil,  iCsFSi  * I LSLAC  ,l{SEElll  * RSF  l.D/; . HSt  FD3 , RST  L 04  * HSLEDb  1 RSEt  1)6  I 1 MCM 

5 tHSf  tt)7*  IESFS'I  * IUitCU,K&EY:>*  ICStCUi  ir.s!  CD  ' Lt  MCM 
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0000S7 

w 

DIMENSION  RSFtD(7) 

LFHCI3 

OOOOftO 

DOUDLF  PKEU5I0M  RSEFD  » RSEEP 1 » K5EED2 1 RSEt 03  f RSEFD'J  t RSEE05 

LFHCM 

1)00061 

1 »RSFFD6,I.S1-Eo7 

LFnCM 

000062 

EOUIVA!  FNCI  ( RSFEOjRSFEDl  ) 

Lf'MCtI 

000063 

IMIlOER  RSTaRTiS)ARTr,SJART2.ENDR  fENDZ 

LFHCM 

000060 

c 

LF  MCM 

00006S 

c 

PAPE  EJECT  CONTROL  Pa((AME1FRS  FOR  LEM 

FAOECH 

000066 

COMMON  /PAOECrl/ 

PAorcM 

000067 

1 NPAol  »NL1NE  fHXLlNt,NSTTL  .SURITLCIOJ 

PAOFCM 

00006(3 

c- 

PAOElM 

000069 

c 

statistical  information  fur  LEM 

STATS 

000070 

COMMON  /STATS  / 

STATS 

00007  1 

1 iter  »NSEGTRjNCAHSR,NYESH  tNREC(7) »NCASCRfNCASDR 

STATS 

000072 

• 

EOUIVAlKNCC  ( NltlTLR  ) 

STATS 

000073 

c 

STATS 

0000/0 

c 

• C A S I N 

000076 

C read  in  flR6T  .(;0*'(7R0l  CARD 

L A S T N 

000076 

RFAOdMPt  1000)  NHlS)T,HMfTOPT»AUNnS,DlSTFF,(JWINO»WPRIOR»APREP» 

LASIN 

000077 

I IAK[)(  1 ) f I AR0(2) 

L'AblN 

000070 

• looo 

FORMAT! 19) 3t3?Xf A0>i2) 

LAS5N 

000070 

NSITL=0 

CAS  IN 

0000(<0 

c 

C A S I N 

oooon  1 

C ECHO  nU7  Fll.st  rONlHOL  card 

L A S u'i 

0000(32 

CALI  rjFLT(l2) 

LAsTn 

0000(33 

WRITE toDTPfPoOo) 

L A S T N 

000060 

?ooo 

FORMAT(?X) 

L AS  1 N 

00006S 

SfiRITL  (riUI  PfPOOO) 

CA&IN 

0000(’.6 

WRIT!  (oUTPf 3000) 

L A S I N 

000067 

3000 

F0tii'AT()‘>X,A«i8L  AS  INPUT  CONTROL  CARDS 

) LAS  IN 

00006(3 

WRirLfnUfPtPooo) 

! A h I N 

0000(3'/ 

WRITE  foUfPjPOOO) 

LAS  IN 

0 00  0 <10 

WRITE tul'IPf 0000)  (If  1=1,9) r(l» 1 = 1 »R) 

LASIN 

00000 1 

oooo 

K)RMAT(3>  ,6I3NHIS1  Y,3X,2MHHf?Xf  9HT0PT,?Xf6HAl)Nl  IS , ?X  1 6H1)  I STF  F * 2X  f 

L A S I N 

0000‘>2 

1 SlibWII'D,'HlH(,lJ,5H)  )f6MwPRI0R|(l(lH(,Ilf3H)  ) fSHAPREP) 

CASIN 

000005  ^ 

WRITE  f O'll  Pf ‘’00u)NM1S  r Y fHM  t tort  fAONlTSfDlSTFFf  Oh  iNnfHPRlQKfAPRtP, 

LAS  IN 

oooo'io 

1 iMvC.I  1)  f IAR0(2) 

CASIN 

(loooo'i 

<>000 

F0K3iAT((lX  ,l3,'(Xf  I3,2x,13f  OXf  l3,SXf  13,KXf  9(1 5 , ?X ) f 6X » 9 ( I 3 1 2X  ) » 3 X f 

L A S I !>l 

0 0 0 0 0 0 

1 I3,3xtA9fI2) 

C A S I N 

nonoo  / 

IF(TARr.(l).63J.3!'LAb.AMD.IARO(?).En.l)  oO  TO  10 

LASTN 

000090 

CALL  Ep('ilFS(3MCAS,SHLAbINf  If  I) 

CASIN 

00000</ 

GO  ru  poo 

CASIN 

(ion  1 00 

c 

, 

CASIN 

oooinl 

C'  check  f-OR  errors 

CASIN 

000102 

10 

CONTI Nur 

CASIN 

000103 

IT  (riMlsTY.LT.l.OR.NKlsiY.  01.20)  CAU  ERRHFS(  3HC  AS  1 EHC  AS  IN,  2t  1 ) 

L A S T N 

0 001  no 

)KMH.Lr.3.nR.HH,GI.99)  CALL  FRRHF  5 ! 3HCAS  f SRC  ASlN,  3i  0) 

CASIN 

OOOlOi 

IF  (TUPi -I*!  .0)  T0PT  = 1 

CASIN 

000  106 

IF (AONJ IS.MF.O)  AUMIIS=1 

CASIN 

00010/ 

IF!P1STI'F.NF  .0)  UtSTF>=1 

LA&TN 

OOOlOO 

IF (APR[( .NL.O)  APRtP=l 

CASIN 

000109 

NOiYrO 

CASIN 

ooono 

DO  ?0  1=1,9 

CASIN 

000  1 1 1 

IfinwiNl  (I).NE.O)  «Is'IM0(I)  = 1 

CASIN 

000112 

ir(HPRli'R(n  ,L]  .O.OR.KPPinRCl)  ,r,T  ,9) 

CASiN 

000113 

1 LAU  1 RRMFS( 3HLASf ShCA$IN,9, 1) 

castn 

000  1 1 9 

ir(31PRl('Ka)  ,Nb.O)  NOW  = Nl35^+l  . 

CASIN 

000  1 1'j 

?o 

r,ONTIM<|F 

CASIN 

0 001  1 6 

11  (NHK,rO.O)  call  tHRMES(3l!CAS,bHCASlM,'L,l) 

L AsIm 

00011/ 

c 

- 

castn 

0 03)1  ui 
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noo  1 19 
oooi?o 
0001?1 
000122 
000123 
000!2« 
00012*3 
000126 
000127 
00  0 12(1 
000129 
0001 <0 
oooni 

000133 

ouono 

OOO  I 33 
000136 
00013/ 
00015(1 
00  0 13,9 

00  0 I <10 

0001  <:  1 
0001  £(2 
oooioi 

00010<l 

oootas 
00  01  /!() 
00010  / 
00010 0 
00.0107 
000130 
000131 
000132 
000133 
000130 
00  013'j 
000136 
000  13/ 
00015B 
000159 
000 1 60 
000161 
000162 
000163 
000)66 
000)65 
000166 
000167 
000160 
000169 
Olio  1 70 
000  tVl 
000172 
0 0 <1 1 7 3 
000176 
000175 
000176 
'oOO 17/ 
0OO17U 


C KEM>  IK  cOKTKOt.  CAkOS  2 AnO  3 CASIN 

200  CONTU.'UF  CA6IN 

READ(lMPt60nO)  ((  IPHn(T»J)tl=i»3)fJ=l»7),IARr.(l)tlAHGC2)  CASIK 

6000  MlHMAI(7(312,lX5f25X»A6,12J  CASIK 

■ WHiTfc(oUrPt2000I  ' CASTK 

WRJTl  (o'irp,  7000)atl  = l»7)  CAST.KI  ■ 

7000  K)l<KAlr3X,/(5HXPl<n(tl2f£lH)  ))  CASIN 

WPITC(oU1P»f'000)  ((  IPRUdtJ)  tl=lt3)fj=lt7)  jIAPG(l)  tIARG(2)  C-ASIN 

OOOO  KiKHAl(SXT7n2tlH/»I2f  lH/>l'2T5X)»5XfA6»I2)  CASIN 

irciAlGCn.f  (1.3ilCAS.AKl7.IAl<G(2).L0.2)  GO  TO  210  ■ CAsTn 

CALI.  I HPMf-Sf  3HCASt5HCASllit  1 1 1)  CASIn 

210  COKTII  ul  CASIN 

RFAIMIhP»6000)  ((IPPDdfJ)fI  = lf3)*J  = atl«)»JARr.(l)*IAKG(2)  CASIN 

■ Ki(XTL(OlJlPt2000)  CASIN 

HlUTl-(oUIPf7000)  (ld  = Stl6)  CASIN 

WPlTtilrtUIPf  AOOO)  {(  tPROU  tJ)  tl=l  t5)  tJ  = 6»1(I)  flAHG(l)  »IARP(2)  CASIN 

IF(I1PC;(  l),r0.3"CAS.A3't),IAKG(2).C0,5)  GO  TO  310  CASIN- 

CALL  fRPIiFS(3HCAS»5HCASINVl  d)  • CASIN 

GO  re  voo  , casin 

310  COMTJKliP  CASIN 

NPOAIIrO  ■ , casin 

OO  320  I=! tl6  • ' CASIN 

II-(It'Pl)(lfn.EO.O.ANl),lPHO(2,n.EO.OI  GO  TO  j50  ' CASIN 

NPum=liPPAI£M  CASIN 

iP(!Pi<i-,(r,n.Gfc,b<i  CASIN 

1 ,AKo.  (IPi?U(2tJI).Ge,l.AN0,IPKO(2»I),Lf.l2'T  CASIN 

I .AND.(IPRU(3tT),Gfc..l.AND.IPRO(3»n.LF.31)J  GO  TO  325  CAsiN 

lAPGUlPlPKOn.IJ  CASIN 

IAI<rU2)  = IPP0(2,.n  CASIN 

IARG(3)  = lPKn(.3in  CASIN 

CALI  I (<l(i-irs  I 3KC  AS  » SHCASIN  1 6 » 1-)  CASIN 

GO ’to  320  . CASTN 

525  COKTlNuF  CASIN 

CAM  |(.PA  (FLOAT(IPRD(3,intlPKO(2f  DtlPROntDfO.fOAYS)  CASIN 

pROAlf  { n = IFlX(nAYS)  CASIN 

320  C'INTINuF  • CASIN 

330  C'JNUNOf  CASIN 

IFIKPPaTL.LE,!)  CD  TO  300  CAslN 

I lhKP2NROAIF~l  . casin 

Of  350  I=lfITFKP  CAsiN 

lKPHnATta),Gt.PRl)AlF(l+n)  CALL  ERKKES{3HCASf5HCASIKt7»I)  . CASIN 

330  CGNTlfluF  , '■  CASIN 

3'40  coktimuf  casin 

S2MAX=  0.?5*ARLAPS*ARFAPS  lasin 

ARtACF=.OOl  CASTN 

VCiPl.O  ' CAsTn 

, I ROr  I-  = 1 . Oh-6  CASIN 

;IF  UUNiTS.tO.!)  GO  TO  600  . CASIN 

,'aRLACF  = . 00026/1066  ' CASIn 

’YCF  = l .<1669666  CASTN 

•PROCF=5.R76356qF-5  CASIN 

C ' ■ CASIN 

600  IF'  ( fiSIKF  .F:<}.  n ) on  TO  900  CASIN 

c casin 

C ‘ nPlN  CAS  OlSTRIOilTiON  FILE,  CASIn 

'■  DEFTNh  Fllfc  6(506f303,U,lIH)M) 

jF  ( rstart  .fo.  0 ) on  ii;  voo  - castn 

C restart  run,  RLAO  AMO  CHECK  HEADER • RECORD.  CASIN 

■ CALL  RaAACF  (CASOIS»l,CASDSB»LCAS0?l3DISF,LTXr>ISt 1)  CASIN 

. NTa  ICaSOC'O  CASIN 


♦ NEW 
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000179 
OOOlPO 
000181 
000182 
000185 
000  IH'4 
OOOlftb 
000186 
000187 
000180 
000189 
000190 
000191 
000192 


. Afu;(60=  6HCASDIS-  tASTN 

ARtK5)=  CASDSD(l)  , ■ CAStN 

C SHTfT  FIlhNAMt  4 CMAHACTEKS  (20  BITS)  TO  THE  LEFT  CAslN 

C BY  hHLT  IPLYIMO  by  CASIN 

• ,lAHr.(«)=  TCASlJ(0’i'i6777?16  . • tASiN 

.If  C CaSO.MHD  .f)E,  OHCASmS  ) CALL  FHHMFS  ( 3HLtH  1 5HC  AS  IN  1 1 9 1 1.)  LASIN 
1AKG(1)=  1CASD(?)  CAi,lN 

a9G(2)=  CAS0SB(5)  . CASIN 

ir  ( IaHSU)  .nf,  icGFcn  .osr.  casi)SB(3)  ,nl,  cuntry  ) casin 

1 call  FKPMES  (3HUMt'iHCASIN»ietn  LiSiN 

IF  ( NT  .Nt.  RSTAin  ) CALL  ERKMLS  ( 5HLF N t bHC AS  I N r 2 t 7 I ) LASIN 

C CASIN 

900  UETDKN  ■ CASIN 

END  CASIN 
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FOR, IS  CASINL 

StIBKUUTIKie  CASINL  CASINL 

C PERFORMS  INITIALIZATION  TASKS  FOR  EACH  PREDICTION  POINT  CASINL 

C • CASINL 

C ’ CAS  CONTROL  CARO  INPUT  DATA  AND  CONSTANTS  , CASCM 

COMMON  /CASCM  / CASCM 

1 AREACF,YCF  ,PRDCF  , APRo'TS  (A,  2)  ,PPRUTS(5,2)  ,YPRUTS(3,2)  CASCM 

2 , AREAPS,-S2MAX  ,MHISTY,HH  , TOPT  , AON  I T S , D I ST  F F , B Wl  ND  ( 4 ) CASCM 

3 ,WPRIOR(4)  ,APREP  , I PRD (3, 14)  , UPDATE tPRDATE ( 14 ) CASCM 

iNTEOEk'  HH,  TOPT,  AUN I fs , DI STF F , BWI ND , WPR I OR , APR EP , PRDATE  CASCM 

C . CASCM 

C FI  AGS  AMD  COUNTERS  FOR  CAS  SIMULATOR  CASFLG 

COMMON  /CASFLG/  CASFLG 

1 H ,PPFLG  ,MBW  ,IBW  , WINDOW, IPD  ,IPP  , P PO AT E , NRE GS  CASFLG 

2 ,MZTOT  ,MSTRAT,NY6SSK,NSSHSK,NCAMSK,NRYFS  ,NRSSH  ,NRCAMS  CASFLG 

3 ,ENDC  ,EMDKEG,  ENDZGN,  I'RSTR  , IRZON’E , IRREG  CASFLG 

4 ,LDS1  ,I.DS4  ,LDS7  ,LDSB  ,LDS9  ,LDS10  ,LDS11  ,LDS12  ,L0S13  CASFLG 

5 ,LDS14  ,LDS15  ,LDS16  ,LDS17  , LRCOUN , LRRE G , L RZON E , L RSTR  CASFLG 

INTEGER  PPFLG  , WINDOW  , PPDATE  CASFLG 

C CASFLG 

C CONTROL  PARAMETERS  FOR  LEM  PROGRAM  CNTRL 

COMMON  /CNTRL  / CNTRL 

.1  PRIMTF  ,NSTART  ,SEEO(  7 ) CNTRL 

integer  PRIMTF  • CNTRL 

DOUBLE  PRECISION  SEED  CNTRL 

C CNTRL 

C FILE  DEFINITIONS  'AND  RECORD  LENGTHS  . FILES 

COMMON  /FILES  / ' FILES 

1 SEGID  rLseGlO,CR()PW  ,LCROPW , SU6HST  ,LSUBH  ,ACOUIS,LACO  FILES 

2 tCAMSF  ,LCAMSF,CAMERR,LCAMER,CASF  ,LCASF  , YE SOUT , L YE  SO  FILES 

3 ■ ,sigext,lsigex,yeserr,lyeser,segtru,lsegtr,casois,lcasd  files 

4 ,1NP  ,nOTP  ,TACO  ,LTACO  , C ASOS F , L C ASDS  fTiFS 

INTEGER  SEGID  ,CROPW  , SUBH ST , ACOU I S , CAM S F ,CAMERR,CASF  ,YESOUT  FILES 

1 , SIGEXT, YESERR, SEOTRU, CASDI S,nuTP  ,TACO  ,CASOSF  FILES 

C FILES 

C PAGE  EJECT  CONTROL  PARAMETERS  FOR  LEM  PAGECM 

COMMON  /PAGECM/  PAGECM 

1 NPAGE  ,NLIME  , MXL I NE , NS TTL  ,SU'BTTL(10)  PAGECM 

C ' PAGECM 

C SUBSTRATA  HISTORICAL  DATA  FROM  SOBHST  FILE  SSHDTA 

COMMON  /SSHDTA/  - SSHDTA 
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1 CnUN2  ,IREG2  ,I20NE2,ISTRA2tISUBS2,NS6G  ,IDSEG  ,GRPN0  ,HISTPW 

SSHDTA 

2 ,AKEAK  ,PWK  ,NAGR  »NA  , DELTPWr DELT PM, CVl  , C V2  ,CV3 

SSHDTA 

3 tCVA  , VMULTK, CLASS ( 18) ,MXK ,RDSSH 

JULY76 

INTEGER  GKPIMO  , CLASS  , ROSSH 

JULY76 

DIMENSION  SSHDTA(39) 

JULY 76 

EUU I VALENCE  ( S SHOT A,  C0UM2  ) 

SSHDTA 

c 

• 

‘SSHDTA 

c 

STATISTICAL  IMFORMATIGM  FOR  LEM 

STATS 

COMMON  /STATS  / 

STATS 

1 ITER  ,NSEGTR,NCAMSR,NYESR  , NRECI 7 ) ,NCASCR ,NCASDR 

stats 

EQUIVALENCE  ( NT,  I TER  ) 

STATS 

c 

stats 

c 

CAS  INL 

c 

INITIALIZE  FLAGS  AND  COUNTERS 

CASINL 

RDSSH=  0 

CAS  INL 

IMREGS=  0 

CASINL 

NZT0T=  0 

CASINL 

NSTRAT=  0 

CASINL 

NRY£S=  NYESSK  - 1 

CASINL 

nrcams=  NCAMSK  - ] 

CASINL 

c 

INITIALIZE  REGION,  ZONEr  AND  STRATA  POINTERS  FOR. CAS 

CASINL 

c 

INTERMEDIATE  FILE.  ( REGION  RECORDS  ARE  3-12,  ZONE  RECORDS  ARE 

CASINL 

c 

13-62,  STRATA  RECORDS  ARE  63-387  ) 

CASINL 

IKREG  = 2 

CASINL 

IRZONE=  12 

CAS INL 

IRSTR  = 62 

CASINL 

c 

CAS  INL 

c 

INITIALLY  POSITION  FILES  YESOUT,  SUBHSl , CAMSF  AT  STARTING  • 

CASINL 

c 

REGION  AND  ZONE. 

CAS  INL 

REWIND  YESOUT 

CASINL 

REWIND  CAMSF- 

CASINL 

00  210  .1=]  , NYESSK 

CASINL 

READ  (YESOUT) 

CASINL 

210 

CONTINUE 

CASINL 

c 

JULY76 

IF  ( NT  .GT.  NSTART  .OR.  IPP  .GT.  1 ) GO  TO  225 

JULY76 

REWIND  SUBHST 

JULY76 

' 

DO  220  I=1,MSSHSK 

CASINL 

READ  (SUBHST) 

CAS  INL 

22  0 

CONTINUE 

CASINL 

NRSSH=  NSSHSK  - 1 

JULY76 

0)  00 
ro  w 

w J 
•J3  (T* 
'X)  o 
p> 

sO 

1 

a 

I 

. U1 


C • . JULY76 

225  DU  230  I=ltNCAMSK  JULY76 

READ  ( CAMSF)  ' CASINL 

230  CONTINUE  ' CASINL 

C CASINL 

900  RETURN  CASINL 

END  CASINL 
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fOR, IS  CASINT 

SlJBRCJUTitME  CASINT  ‘ CASINT 

PERFORMS  MISCELLAMEOUS. INITIALIZATION  TASKS  FOR  THE  CAS  CASINT 

SIMULATOR  ■ CASINT 

1.  SETTING  COUNTERS  AND  FLAGS  • CASINT 

• 2.  OPENING  RANDOM  ACCESS  FILE  (CAS  INTERMEDIATE  FILE)  CASINT 

3.  DETERMINING  HOW  MANY  RECORDS  TO  SKIP  ON  THE  YESOUT,  CASI'NT 

SURHST,  AND  CAMSF  FILES  TO  PROPERLY  PO S I T I ON . T HOSE  FILES  CASINT 
AT  THF  STARTING  REGION  AND  ZONE  ( STARTR  AND  STARTZ)  CASINT 

CASINT 

ARGUMENT  LIST  FOR  ERROR  PROCESSING  . ARGLST 

COMMON  /ARGLST/  ‘ A.RGLST 

1  NERRS  ,NFATAL»NPERKS,NARG  ,ARG(10)  • ARGLST 

DIMENSION  lARG(lO)  ARGLST 

EQUIVALENCE  (IARGtARG  ) ARGLST 

ARGLST 

CAS  CONTROL  CARD  INPUT  DATA  AND  CONSTANTS  CASCM 

COMMON  /CASCM  / CASCM 

1 AR£ACF,YCF  t'PRDCF  ,APRUTS(4»2)  ,PPRUTS(5»2)  ,YPRUTS(3,2)  CASCM 

2 , AKEAPSt S2MAX  ,NHISTY,HH  ,TOPT  , AON  I TS , DI ST FF , R WI ND ( 4 ) CASCM 

3 ,WPRI0R(4)  ,APREP  rIPRD(3»14)  , NPDATE r PROATE ( 14 } CASCM 

•INTEGER  HH,  TOPT,  AUN I TS , D I STF F , BW I ND , WPR I DR t A PR EP » PRD AT E CASCM 

CASCM 


DATA  BLOCK  FOR  CAS  CUMULATIVE  FILE  • CASCUM 

CAS  DATA  SETS  14,  15,  16,  AND  17  , CASCUM 

COMMUM  /CASCUM/  CASCUM 

1  CASCUM(32),  6UFFR(504)  CASCUM 

DIMENSION  ICASC(32),  0SET14(22),  DSET15(22),  0SET16(22)  CASCUM 

1 ,nSET17(28)  CASCUM 

EQUIVALENCE  ( ICASC, CASCUM  ) CASCUM 

EQUIVALENCE  ( OS E T 14 , DS E Tl 5 , D SET  16 ,OS6 T 1 7 , C ASCUM { 5 ) ) CASCUM 

1 , { S(;)AeRS,S0AERZ,SQAERR,SQAERC,CASCUM(24)  ) Ta-^cuM 

2 , ( S(OPERS,S(^PERZ,SQPERR,SOPEKC,CASCUM(  25)  ) CASCUM 

3 , ( SQYERS,SQYER7 ,SQYERR,SQYERC,CASCUM(26)  ) CASCUM 

C . CASCUM 

C ■ FLAGS  AMD  COUNTERS  FOR  CAS  SIMULATOR  CASFLG 

COMMON  /CASFLG/  . . CASFLG 

1 H ,PPFLG  ,NBW  ■ ,IBQ  ,WI'MDUQ,IPD  ,IPP  , P PD  AT  E , NREGS  CASFLG 

2 ,NZTOT  ,NSTRAT rNYESSK jNSSHSK  ,NCAMSK ,NRYES  ,NRSSH  ,NRCAMS  CASFLG 

3 ,ENDC  ,ENDKEG,EMDZ0N, IRSTR  , I RZON E , I RREG  CASFLG 

•4  ,LDS1  ,LDS4  ,LDS7  ,LDS8  ,LDS9  ,LDS10  ,LDS11  ,LDS12  ,LDS13  CASFLG 
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5 ,l_DS14  ,L0S15  ,tnS16  ,LDS17  ,LRCn UN  , LRREG  t UR Z ON E , LR SIR  CASFLG 

INTEGER  PPFLG  t WINOnW  t PPDATE  CASFLG 

C CASFLG 

C ■ CONTROL  parameters  FOR  LEM  PROGRAM  • CNTRL 

COMMON  /CNTRL  / ‘ CN’TRL 

1  PKINTF,MSTART,SEED<7)  CNTRL 

INTEGER  PRINTF  . CNTRL 

. DOUBLE  PRECISION  SEED  CNTRL 

C CNTRL 

C CONSTANT  QUANTITIES  FOR  LEM  PROGRAM  ' . CONST 

COMMON  /CONST  / . CONST 

1  NTRMX  ,MAXR  ,MAXZ  , I MX S EG» ENDF I L , I TSFG  CONST 

C DON ST 

C file  DEFINITIONS  AND  RECORD  LENGTHS  FILES 

COMMON  /FILES  / FILES 

1 SEGID  ,LSEGIO,CROPW  , L CKOPW, SU BHS T , L SUBH  tACQUlS,LACO  FILES 

2 tCAmSF  ,LCAMSFtCAMERRTLCAMER tCASF  »LCASF  » YE SOUT t UY ES 0 FILES 

3 ,S1GEXT,LSIGEX ,YESERR»LYESERt SEGTRU,LSEGTR,CASDIS,LCASD  FILES 

4 ,IMP  tOUTP  ,TAC(0  ,ltaco  ,c asdsf  ,lcasds  files 

INTEGER  SEGIO  ,CROPW  , SUB HST r A C 00  I S , C AMSF  ,CAMERR,CASF  tYESOUT  FILES 
I ,SIGEXT,YE5ERR,SEGTRO,CASDIS,OUTP  ,TAC0  tCASDSF  files 

c files 

C INDEX  RECORD  FOR  CAS  INTERMEDIATE  DATA  SET  FILE  (CASDSF)  IXCDSF 

COMMON  /IXCDSF/  ’ IXCDSF 

1 IXCDSF  ( 1)  ,1-IXCOS 

C IXCDSF 

C LEM  CONTROL  CARD  INPUT  DATA  LEMCM 

COMMON  /LEMCM  / ' LEMCM 

1 TITLF(IO)  ,ICASE  tCUNTRY  rNTRI-ALjRSTARTrlPRINTrSTARTRtSTARTZ  LEMCM 

2 tENDK  tENDZ  ,ISTG  »ICAMS  ,IYES  ,IAC0  , ICLASS, ISEXT  ,ISCC  LEMCM 

3 »ICAS2  ,ICAS3  , I PRC  AM , I PR YE S » I PRC AS » I C S ESG , I CS EC W » IC 5ESH t I CSECE  LEMCM 

4 t ICSEYM,  iCSESEt  ICSEAC,RSEE01,  RSEED2,  RSEED3,RSEED4,RSEED5,RSEED6  L'-^CM 

5 ,RSEE07,ICSESTtICSEC0,ICSEYS  » ICSECU  . I CS  ECD  M.EMCM 

DIMENSION  RSEED(7'  • LEMCM 

DOUBLE  PRECISION  RSEED  , K SEED  1 1 RSE ED 2 , RS EED3 , RS EED4 , RSE ED 5 LEMCM 

1 tKSEEDS,  RSF.ED7  LEMCM 

' equivalence  ( RSEED, RSEEDl  ) LEMCM 

INTEGER  RSTART,STARTR,STARTZ,EMDR  ,ENDZ  LEMCM 

C ' LEMCM 

C PAGE  EJECT  CONTROL  PARAMETERS  FOR  LEM  PAGECM 

COMMON  /PAGECM/  PAGECM 


28234-6029-RU-51 
Page  401a 


oo  ooOoOoOoOoOo  o n nO  -oo  on 


'l  NPAGE  tNLINE  »MXL  INE  » MS  TTL  » Si)  BT  T‘_  ( 10 ) ' PAGECM 

PAGECM 

STATISTICAL  INFORMATION  FOR  LFM  STATS 

COMMON  /STATS  / STATS 

1 ITER  ♦NSEGTRtNCAMSRtNYESR  ,NRE C ( 7 ) » NCASCR » NCASDR , StATS 

EOOIVALENCE  ( NT, ITER  ) • STATS 

STATS 

yield' DATA  FROM  YFSOUT  FILE  ' YESDTA 

COMMON  /YESDTA/  YESDTA 

1 YSTK  ,1ZPRDD(6)  ,YSCI(A)  ,VSYCI(6)  YESDTA 

2 ,ROYES  ,NYESPP  . YESDTA 

integer  RDYES  . YESDTA 

YESDTA  , 

debogging  print  flag  CASINT 

COMMON  /DEBUGF/  DEBUGF  CASINT 

CASINT 

DATA  DEBUGF  / 0,0  / CASINT 

CASINT 

INTEGER  REGION,  ZONE,  STRATA  CASINT 

CASINT 

LOCAL  VARIABLES  CASINT 

COON  = COUNTRY  ID  CASINT 

REGION  = REGION  ID  CASINT 

ZONE  = ZONE  ID  . CASINT 

STRATA  = STRATUM  ID  CASINT 

ICODE  = ERROR  MESSAGE  CODE  FOR  ERRMES  CASINT 

FILL  = TEMPORARY  CELL  USED  TO  FILL  OUT  LIST  IN  READ  STMT.  CASINT 

I = DO  LOOP  INDEX  CASINT 

CASINT 
CASINT 

INITIALIZE  flags  AND  COUNTERS  CASINT 

PPFLG=  0 CASINT 

IPP  = 0 CASINT 

NSTTL=  0 CASINT 

CASINT 

CLEAR  BUFFER  REGION  FOR  CAS  CUMULATIVE  FILE  CASINT 

DO  110  I=1,LCASF  CASINT 

-■  BUFFKI  I )=  0.0  . • CASINT 

'110  CONTINUE  ■ CASINT 

C ■ ■ CASINT 

C OPEN  CAS  INTERMEDIATE  FILE  (RANDOM  ACCESS  FILE)  — CASDSF  CASINT 
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CAS INT 

HEKFOKM  THE  FOLLOWING  CHECKS  ONLY  ON  THE  FIRST  ITERATION  CASINT 

IF  ( NT  .GT.  NSTART  ')  GO  TO  900  CASINT 

• CASINT 

H=  HH  CASINT 

CASINT 

SKIP  OVER  THE  HEADER  RECORD  OF  THE  YESGUT»  SOBHST » AND  CAMSF  CASINT 
FILES.  ‘ CASINT 

REWIND  YESOOT  CASINT 

rewind'  SUBHST  ■ CASINT 

REWIND  CAMSF  CASINT 

READ  (YESntJT)  CASINT 

READ  (SUBHST)  CASINT 

READ  (CAMSF)  CASINT 

NYESSK=  1 • . CASINT 

NSSHSK=  1 . CASINT 

NCAMSK=  1 CASINT 

IF  ( S1ARTR  -EO.  0 ) GO  TO  900  JULY76 

CfjONT  THE  NO.  OF  RECORDS  TO  SKIP  ON  YESOOT  CASINT 

ARG(3)=  6HYES0UT  • CASINT 

210  READ  (YESOOT)  COON , REG  I ON , ZOM E , ST R AT A , Y STR  CASiNT 

1 , ( I ZPRDO( I ) ,Y5CI ( I ) , VSYC I ( I ) ♦ I=l »6  ) CASINT 

CASINT 

IF  ( COON  .ECO.  EMDFIL  ) GO  TO  800  • ' CASINT 

CASINT 

IF  ( REGION  - STARTR  ) 250,240t800  CASINT 

REGION  = STARTING  REGION  CASINT 

240  IF  ( ZONE  - STARTZ  ) 250,300,820  CASINT 

250  NY6SSK=  NYESSK  + 1 CASINT 

GO  TO  210  CASINT 

CAS  INT 

COUNT  NUMBER  OF  RECORDS  TO  SKIP  ON  SUBHST  FILE  C-'^^TMT 

300  ARG(3)=  6HSUBHST  CASiNT 

310  READ  (SUBHST)  COON  . R EG  I ON  , ZONE  , ( F I LL  , I = 4 , L SLlbH  ) CASINT 

IF  { COON  .EO.  EMDFIL  ) GO  TO  800  CASINT 

IF  ( REGION  - STARTR  ) 350,340,800  CASINT 

C REGION  = starting  REGION  CASINT 

340  IF  ( ZONE  - STARTZ  ) 350,400,820'  CASINT 

350  NSSHSK=  MSSHSK  + 1 CASINT 

GO  TO  310  CASINT 

C CASINT 
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C COUNT  NUMBER  OF  RECORDS  TO  SKP  ON  CAMSF  CASINT 

400  AKC(3)=  5HCAMSF  ’ CASINT 

410  READ  (CAMSF)  COUN  t R EG  I ON , Z.ONE  » ( F ILL , I = 4»LCAMSF  ) „ CASINT 

IF  I COUN  .EtO,  EMOFIL  ) GO  TO  800  • CASINT 

IF  ( REGION  - STARTR  ) 4!50»440»800  CASINT 

C REGION  = STARTING  REGION  ' ' CASINT 

440  IF  ( ZONE  - STAKTZ  .)  450,900^  820  CASINT 

450  NCAMSK=  NCAMSK  + 1 CA-SINT 

GO  TO  410  . CASINT 

CASINT 

ERROR.  STARTING  REGION  NOT  FOUND  ON  FILE  - CASINT 

800  ICUDE=  3 CASINT 

ARG(1)=  6HKEGI0N  CASINT 

GO  TO  830  CASINT 

C ' CASINT 

C ERROR.  STARTING  ZONE  NOT  FOUND  ON  F.ILE  CASINT 

820  ICOI.)E=  4 CASINT 

ARG( 1 )=  6HZ0NE  CAS  INT 

830  CALL  ERRMES  ( 3HCA S , 6HCAS I NT , I CODE , 1 ) • CASINT 

C CASINT 

900  RETURN  CASINT 

END  CASINT 
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l-GRtlS  CASOUT 

SUBROUTINE  CASOUT ( 1 LEVEL)  CASOUT 

THIS  SUBROUTINE  PRINTS  THE  AREA  AND  PRODUCTION  REPORT  AND  SAVES  OATACASOUT 
FOR  THE  COUNTRY  REPORT  - CASOUT 

ARGUMENT  LIST  FOR  ERROR  PROCESSING  ■ AR'GLST 

COMMON  /ARGLST/  ' ARGLST 

1  NERRS  tNFATAL »NPFRRS,NARG  ,ARG(10)  . ARGLST 

DIMENSION  -IARG(IO)  ARGLST 

EOUIVALENCE  ( IARG,ARG  ) ARGLST 

ARGLST 

file  DEFINITIONS  AND  RECORD  LENGTHS  FILES 

COMMON  /FILES  / • FILES 

1 SEGID  tCSEGIDtCROPW  , L CROPW , SUBHS  T , L SUtJH  ,AC0UIS,LACQ  FILES 

2 tCAMSF  ,LCAMSF,CAMERRtLCAMER ,CASF  ,LCASF  , Y E S OUT , LY ESO  FTLES 

3 ,SlGEXT,LSIGE-X,YESERR»LYESERrSEGTRUrLSEGTR,CASDlSTLCASD  FILES  . 

4 ,INP  ,OUTP  ,TACO  tLTACO  »C ASD SF , LCA SD S FILES 

INTEGER-  SEGID  , CROPW  , SUBHST, ACOU I S , CAMSF  »CAMERRtCASF  ,YESOUT  FILES 

1 ,S IGEXT , YESERR,SEGTRU,CASDISrOUTP  ,TACQ  ,CASDSF  FILES 

FILES 

SUMMARY  DATA  FDR  REPORTS  SUMDTA 

COMMON  /SUMDTA/  SUMDTA 

'l  CVAEPT  ,CVEPTA,SDPER  ,CVPEPT  tCVEP  TP  ,C'SUMR  ( 18 , 18  ) SUMDTA 

SUMDTA 

CAS  CONTROL  CARD  INPUT  DATA  AND  CONSTANTS  . CASCM 

COMMON  /CASCM  / . CASCM 

1 AREACF,YCF  ,PRDCF  ,APKUTS(4,2)  ,PPRUTS(8»2)  ,YPRUTS(3»2)  CASCM 

2 ,AREAPS,S2MAX  ,NHISTY,HH  ,TOPT  , AON  I TS , D I ST FF , BWI ND { 4 I CASCM 

3 ,WPRIGR(4)  ,APREP  ,IPRD(3»14)  , NP D ATE , PRDAT E ( 14 ) CASCM 

integer  HH,  TOPT,  AUNITS ,DISTFF,BWIND, WPRIOR, APREP,  PRDATE  CASCM 

CASCM 

DATA  BLOCK  FOR  CAS  CUMULATIVE  FILE  CASCUM 

CAS  DATA  SETS  14,  15,  16,  AND  17  C'RFilM 

CUMMON  /CASCUM/  ’>  CASCUM 

1 CASCUM  (32),  Bl'FFR(504)  CASCUM 

DIMENSION  ICASC<32),  DSET14(22),  DSET15(22),  DSET16(22)  CASCUM 

1 ,DSET17(28)  CASCUM 

EOU I VALENCE  { I CASC, CASCUM  ) . CASCUM 

EQUIVALENCE  ( DS ET 14  ,DS ET 1 5 , D SET I6 , D S ET 1 7 , C ASCUM ( 5 ) ) CASCUM 

1 , ( SOAERS,SOAERZ,SOAERR,SQAERC,CASCUM( 24)  ) CASCUM 

2 , ( SOPERS,SQPERZ, SQPERR, SOP ERC, CASCUM ( 25)  ) CASCUM 

3 , ( SOYEKS,SOYERZ,SOYERR,SOYERC,CASCUM{26 ) ) CASCUM 
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CAS CUM 

FLAGS  AND  COUNTERS  FOR  CAS  SIMULATOR  CASFLG 

COMMON  /CASFLG/  ' CASFLG 

1 H ,PPFLG  tNUW  ,IBW  , window, IPD  tIPP  tPPDATEtNREGS.  CASFLG 

2 tNZTOT  ,NSTKAT,MYESSK,NS5HSK,NCAMSK,NRYES  ,NRSSH  ,NRCAMS  CASFLG 

3 ,Ei\lDC  ,ENDR£G,ENOZON,  IRSTR  , I RZONE , I RK  EG  CASFLG 

4 ,LI)S1  ,LDS4  ,LDS7  ,LDS8  ,LDS9  ,LnSI0  ,LL)S11  ,LDS12  ,LDSL3  CASFLG 

5 ,LDS14  ,-LDS15  ,Ln.S16  ,LOS17  ,LRCOUN  ,LRREG  ,LRZDNE  ,LRSTR  CASFLG 

INTEGER  PPFLG  , WINDOW  , PPOATE  CASFLG 

CASFLG 

LEM  CONTROL  CARD  INPUT  DATA  ’ , LEMCM 

COMMON  /LEMCM  / ■ LEMCM 

1 TITLE(IO)  ,ICASE  ,CIIMTRY,NTRIAL,  KSTART,  I PRINT,  STARTRtSTARTZ  LEMCM 

2 tENDR  tENOZ  ,ISTG  ,ICAMS  ,IYES  ,IACQ  , ICLASS, ISEXT  ,ISCC  LEMCM 

3 ,ICAS2  tlCAS3  , I PRC  AM , I P R YES , I P RC AS , I C SE SG , I C SE C W, I CS ESH , I CS ECE  LEMCM 

4 , ICS6YM,  ICSESE,  ICSEAC,RSEED1  ,KSEED2  ,R.SEED3  ,RSEED4,RSEED5,RSEED6  LEMCM 

5 ,RSEED7, ICSEST, ICSECO, ICSEYS, ICSECU, ICSECD  LEMCM 

DIMENSION  RSEED(7)  LEMCM 

DOUBLE  PRECISION’  RSFED  , RSEED 1 , RSEE D2 , RSE ED3 , R SE ED4 , RS EED5  LEMCM 

1  ,RSEED6  ,RSEED7  LEMCM 

EOUIVALENCF  ( RSEFO,RSEEOl  ) LEMCM 

INTEGER  RSTART ,STARTR ,STARTZ, ENDR  ' , 6NDZ  LEMCM. 

LEMCM 

PAGE  EJECT  CONTROL  PARAMETERS  FOR  LEM  . PAGECM 

COMMON  /PAGECM/  PAGECM 

I NPAGE  ,NLINE  tMXLlNE ,NSITL  ,SUBTTL(10)  PAGECM 

PAGECM 

STATISTICAL  INFORMATION  FOR  LEM  STATS 

COMMON  /STATS  / ' STATS 

1 ITER  ,MSEGTK,NCAMSR,NYESR  ,NREC ( 7 ) ,NCASCR ,NCASDR  STATS 

EOUIVALENCE  ( NT, ITER  ) SI  ATS 

C <'tats 

C CAS  data  set  7 (AT  ZONE  LEVEL)  DSET7 

COMMON  /0SET7  / DSET7 

1 ZONE  ,HWAZ2  ,EZ  , M 1 1<2  KZ,  AN  AL  V Z , NSTR  AZ , H WAZ  1 ,EWAZ1  ,HWAZ3  JULY76 

2 ,ESTVZ  ,HWAZ12  JULY76 

3 ,M1K2CL(10)  ,EPWCL(10)  ,EPW2CL(10)  ,PKPICL(10)  , JULY76 

4 ,PK2CL(10)  tPKCLdO)  ,SS‘0(10)  JULY76 

INTEGER  ZONE  J0LY76 

REAL  M1K2KZ,  MIK2CL  JULY76 

DIMENSION  DSET7(81)  JULY76 


28234- 6029-RU-51 
Page  405a 


n o o • no 


EOUIVALENCE  ( DSET7,ZnNE  ) DSET7 

DSET7 
CASOUT 

EOU  I valence  (CASCUM  ( 1 ) »IREG  ) , ( CASCUM(  2 ) t I ZONE)  t ( CAS  CUM  (3  ) , lSTRA)-»  CASOUT 

1 (CASCUM(5 ) ,HWA) t ( C ASCUM ( 6 ) , T WA ) , ( CA SCUM ( 7 ) , E WA ) , CASOUT 

1 (CASCUM(8) rAERR ) t ( C ASCUM { 9 ) » AV AR ) , ( CASCUM ( 10 ), TPROD ) , CASOUT 

1 ( CASCUM  (U),EPROD),  ( CASCUM  ( 12  )»  PRERR  ) , ( CASCUM  ( 13  ) t PRVAR  ) , CASOUT 

1 ( CASCUM( 14 ) ,TY ) , ( CASCUM ( 15 > r E Y ) , ( C AS CUM ( 16 ) , YE RR ) , CASOUT 

1 ( CASCUM ( 22  ) »ANAV  ) , CASOUT 

1 ( CASCUM (23 ), AMPRV ) , ( CASCUM ( 24 )» SO AER ) , ( CASCUM ( 25 ) t SQPER) » CASOUT 

1 ( CASCUM  ( 26  >,  SOYER  ) t ( C A SClJM  ( 2 7 ) » C LE WA  ) , { C ASCUM  ( 2 8 ) t CL  EPRD  ) , CASOUT 

1 (CASCUM(29) jCLATEC ) r ( C A SCUM ( 30 ) ,CLP TEC ) , ( C A SCU M ( 3 1 ) ,C L AT WC ) t CASOUT 

1 (CASCUM(32)»CLPTWC)  . CASOUT 

INTEGER  M1J,M2J tCT) ,CT2»CT3  CASOUT 

CASOUT 
CASOUT 

CONVERT  UNITS  AND  GET  MEAN  ( CASCUM)  CASOUT 

FNT=FL0AT (NT ) CASOUT 

HWA  =HWA4AREACF/FNT  CASOUT 

TWA  =TWA*AREACF/FMT  CASOUT 

E'WA  =EWA^i'AREACF/FNT  CASOUT 

AERR  =AERR*AREACF/FNT  CASOUT 

AVAR  =AVAR*AREACF*AREACF/FNT  CASOUT 

TPROD  =TPRClp-PRnCF/FNT  ’ CASOUT 

EHRUD  ^EPRah^iUJROCF/FMT  CASOUT 

PRERR  =PRERR*PR0CF/FNT  CASOUT 

PRVAK  =PRVAR';<P'RDCF*PRDCF/FMT  CASOUT 

TY  =TY>!'YCF/FNT  CASOUT 

EY  =EY>;'YCF/FMT  CASOUT 

YERR  =YERR*YCF/FNT  CASOUT 

MU  = CASCUM  n 7 ) /FMT  CASOUT 

M2J  = CASCUM( 18 )/FNT  CASOUT 

CTl  = CASCUM ( 19 ) /FNT  CASOUT 

CT2  = CASCUM( 20 )/FNT  CASOUT 

CT3  = CASCUM(21 )/FNT  CASOUT 

ANAV  =ANAV4AREACF*AREACF/FNT  CASOUT 

ANPRV  fANPKV4PRDCF*PRDCF/FNT  CASOUT 

S(OAER  =S(JAER*AREACF*AREACF  CASOUT 

S(JPER  =S(OPER-PROCF^i^PRD(:F  CASOUT 

SOYER  =S(0YER^'YCF'^YCF  CASOUT 

C CASOUT 
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C COMPUTE  VALUES  FOK  COUNTRY  (CASCUM) 
IF(  ILEVEL  .NE.O)  GO  TO  10 
CLEWA  =CLEWA/FNT 
CLEPKU  =CLEPKD/FNT 
CLATEC  =CLATEC/FNT 
CLPTEC=CLPTEC/FNT 
CLATWC  =CLATWC/FNT 
CLPTWC  =CLPTWC/FNT 


COMPUTE  OTHER  VALUES  ( SIJMDTA  ) 

10  CONTINUE 

CVAEPT=  SORT{ AVAR )/TWA«100.0 
CVPEPT=  SORT (PRVAR )/TPROD"aOO.O 
CVEPTA=0. 

SDPEK^O. 

CVEPTP=0. 

IF (NT. £0.1)  GO  TO  20 

ARG{1)=  ( SOAER  - AERR*AERR*FNT  )/(FNT-1.0) 

IF  ( ARGO)  .GT.  0.0  ) CVEPTA  = ( SORT { ARG (1 )) /TWA  I^IOO.O 
ARG(1)=  ( SOYER  - YERR>:‘YF,RR^-FNT  )/(FMT-1.0) 

IF  { ARG( 1 ) .GT.  0.0  ) SOPER  = SORT ( ARG(l)  ) 

AKG(1)=  ( SOPER  - PRbRR^'PRGRR>-FNT  )/(FNr-1.0) 

IF  ( ARG(l)  .GT.  0.0  ) ’CVEPTP  = SORT(  ARG(l)  )/TPROD  =:'100.0 
20  CONTINUE 


PRINT  LINE  ON  AREA-  REPORT 

IF(APREP.EO.O)  GO  TO  30 


NEW  PAGE 

IF(  ILEVEL  .NE«U  GO  TO  50 
IF  { EMDREG  .ME.  0 ) GO  TO  25 
ICHK=  NSTRA2  +9  +NLINE  I 

IF(  ICHK.LT.MXLINE  ) GO  TO  50 
25  CALL  APHDR 


C 

C STRATA  LINE 
50  CONTINUE 

IF{  ILEVEL.LE.O)  GO  TO  60 
CALL  PAGER!  1) 

WRITE  (GUTPtlOOO)  I R EG , I ZOM E t I S TR A , 
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1 TWAtEWAtCTl»CT2tCT3,MlJtM2J,CVAEPTTCVEPTA,TY,Ey» 

1 SDPERtTPKOD  TEPKnD,CVPEPT  tCVEPTP 
1000  FUKMAT  { IX , 2 ( I 3 , IX ) , I 4 , 2 X r 2 ( F B. 1 , 1 X ) » 3 ( IX t I 4 ) , 2X , 

1 2(I4,lX),lXt2(F6.1,lX),lXt3(F6.2rlX),lX,2(F8.1,lX)r2(F6.i»lX)) 
■ GO  TU  30 

ZONE  LIJME 
60  CCJMTINUE  • 

IF( ILEVEL.ME.-2)  GO  TO  70 
CALL  PAGER {6) 

WRITE  (OUTPt30OO) 

WRITE(OUTP  ,2000  ) 

2 000  FORMAT  ( IX,  20  ( ) 

WRIT£(OUTP  ,3000  ) 

3000  FORMAT (2X) 

WRITE(OUTP  ,4000  ) 

4000  FURMAT( IX , 3HREG , 2X , 4HZGNE ) 

WRITE  (OUTP,50OO)  IREG,IZONE, 

1 TWA,EWA,CTi,CT2,CT3,MlJ,M2J,CVAEPT ,CVEPTA,TY,EY, 

1 SUPER, TP RODtEPRDD ,CVPEP  r , CVEPTP 
3000  format  ( LX,2( 13, IX)  ,6X,  2 ( F 8 , 1 , IX ) , 3 ( IX , 1 4 ) » 2X , 

1 2(I4,1X),1X,2(F6.1,1X),1X,3(F6.2,1X),1X,2(F8.1,1X),2(F6.1,1X)) 
WR  TTE (OUTP ,3000 1 
. WRITE(0IJTP  ,2000  ) 

WRITE  ( (JUTP  , 2000  ) 

WRITE(UUTP  ,3000) 

GO  I U 30 
C 

C REGION  LEVEL 
70  CONTINUE 

IF( ILEVEL.NE.~1 ) GO  TO  80 

CALL  PAGER (4) 

write  (OUTP, 6000)  IREG, 

1 TWA,EWA,CT1 ,CT2,CT3,M1J,M2J,CVAEPT,CVEPTA,TY ,EY, 

1 SnPER,TPKOD, EPR00,CVPEPT ,CVEPT  P 
6000  FORMAT  ( 1 X , 6H REG I ON , 3 X , I 3 , 2 X , 2 ( F8 . 1 , IX ) , 3 ( iX , I ^ ) , 2X , 

1 2(I4,1X),IX,2(F6.1,IX),1X,3(F6.2,1X),1X,2(F8.1,]X),2(F6.1,1X)) 
GO  TO  30 
C 

C COUNTRY  LEVEL 
80  CONTINUE 
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CASOUT 
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CALL  PAGER(5) 

WHITE  (0UTP,3000) 

WK  ITE  (OUTP'r  2000  ) 

WRITEIOUTP  ,2000  ) 

WHITE ( 0UTP,3000 ) 

WHITE  (OUTPtTOOO) 

1 TWA,EWA,CT1,CT2,CT3,MIJ,M2J,CVAEPT,CVEPTA,TY,£Y, 

1 SDPER,TPROn,EPROO,CVPEPT,CVEPTP 
■7000  FORMAT  { IX , 7HCDUMTRY , 7X , 2 ( F8 , 1 , IX ) , 3 ( IX , 1 4 ) , 2X , 

1 2(I4,1X),1X,2(F6.1,1X),1X,3{F6.2,1X),1X,2(F8.L,]X),2{F6.1,LX)) 
C 

Q * »;<  * if  if  * * if  if  s;:  if  s|s  if  if if  if  if  if  5i<  if  sK  -f  ❖ ❖ v >l<  ❖ if  5l'  ’1-  if  ’r  ^ if if 

C SAVE  VALUES  FOR  COUNTRY  REPORT 
30  CONTINUE 

IF( ILEVEL.NE.O ) RETURN 
CSUMH( 1, IPP )=EWA 

CSUMK(2,1PP )=  ( SORT (AMAV) /TWA) *100, 

CSUMR(3, IPP)=CVAEPT 
CSUMH (4, IPP )=CVEPTA 
CSUMR( 5 , IPP )-EY 
CSUMH( 6, IPP )=SOPER 
CSUMR( 7, IPP )=EPRGD 

CSUMR( 8, IPP )=( SORT ( ANPRV)/TPROD )*100. 

CSUMR(y, IPP )=CVPEPT 
CSUMH  (10,  IP'P  ) = CVEPTP 
CSUMR( 12 , IPP )=CLEWA 
CSUMH ( 13, IPP )=CLATEC 
CSUMR{  14  , IPi^)  =CLATWC 
CSUMK(  16,  IPP  )=CLEPRI5 
CSUMR{ 17, IPP )=CtPTEC 
CSUMR( 18, IPP )=CLPTWC 
900  RETURN 
END 
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CASOUT 
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FUKtIS  CASPP 

SUBROIJTINF  CASPP  CASPP 

■ PERFORMS  THE  FIRST  PASS  CAS  COMPUTATIONS  GENERATING  DATA  SETS  CASPP 
1-9.  CASPP  ALSO  CALLS  CAS3  TO  GENERATE  DATA  SETS  10-19.  ’CASPP 

CASPP 

ARGUMENT  LIST  FOR  ERROR  PROCESSING  ARGLST 

COMMON  /ARGLST/  ARGLST 

1 NERRS  tNFATALrNPERRS ,NARG  tARG(lO)  ARGLST 

DIMENSION  lARG(lO)  ARGLST 

EOUIVALENCF  ( lARGtARG  ) ARGLST 

ARGLST 

FLAGS  AND  COUNTERS  FOR  CAS  SIMULATOR  CASFLG 

COMMON  /CASFLG/  CASFLG 

' 1 • H ,PPFLG  tNBM  ,IBW  , WINDOW, IPD  ,IPP  , PP DATE , NREGS  CASFLG 

2 ,MZTOT  ,NSTRAT,NYESSK,MSSHSK,MCAMSK,NRYES  ,NRSSH  tNRCAMS  CASFLG 

3 ,ENDC  ,ENDREG,ENDZ0M, IRSTR  t IRZONE , IRREG  CASFLG 

4 ,LC)S1-  ,LDS4  ,LDS7  ,LDS8  ,LDS9  ,LDS10  ,LDS11  ,LDS12  ,LDS13  CASFLG 

5 ,Lf)S14  ,LDS15  ,LDS16  ,LDS1'/  tLRCOUN  ,LRREG  , LRZOME , LRSTR  CASFLG 

INTEGER  PPFLG  , WINDOW  , PPDATE  CASFLG 

CASFLG 

control  PARAMETERS  FOR  LEN  PROGRAM  CNTRL 

COMMON  /CNTRL  / • CNTRL 

1 PKIMTF,NSTART, SEFD(7 ) CNTRL 

INTEGER  PRINTF  ' CNTRL 

DOUBLE  PRECISION  SEED  CNTRL 

CNTRL 

CONSTANT  QUANTITIES  FOR  LEM  PROGRAM  CONST 

COMMON  /CONST  / -CONST 

1 MTRMX  ,MAXR  ,MAXZ  , I MXSEG , ENDF I L , I TSFG  CONST 

CONST 

CAS  DATA  SETS  1,2,  AND  3 DSETl 

COMMON  /DSETl  / DSETl 

1 ISUBST,TWAK  ,HWAK  ,FWAK  ,f^lK  ,CTlK  ,ANALVK,EPWK  ,EPW2K  JULY76 

2 ,SMPKPI  ,SUMPK2,SIJMPI<  ,KSUB  ,NCLASS  JULY76 

• REAL  MIK  , M2K  JULY76 

DIMENSION  DSETl (14),  DSET2(14),  DSET3(6)  JULY76 

EQOIVALENCE  ( DSFl  1,DSET2,DSET3, ISUBST  ) DSETl 

1 , { M2'K,(^1K  ),  ( CT2K,CT3K,CT1K  ) DSETl 

DSETl 

CAS  DATA  SETS  4,  3,  AND  6 (AT  STRATA  LEVEL)  0SET4 

COMMON  /nSETA  / • DSE14 
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1 . STKATAtTWASl  tHWASl  »EWAS1  ,XM1JS  ,XCT1S  ,ANVS1  JULY76 

2 »TWAS2  tHWAS2  »EWAS2  ,XM2JS  ,XCT2S  tANVS2  ,T  JULY76 

3 , TWAS3 ,HWAS3tXCT3S 

4 tXYS  ,XESTYS,EVYRS’  ,P2 IDPK,V1V2S  ,VARS  , ANVARS  JULY76 

5 ,HILL4(57)  ' 

INTEGER  STRATA  ' • = • JULY76 

DIMENSION  DSET4(24),  DSET5(7),  DSBT6(3)  JULY76 

EQUIVALENCE  ( DSET4, STRATA  )»■(  DSET5,TWAS2  ),  ( DSET6»TWAS3  ) DS6T4 

- ' 0SET4 

CAS  DATA  SET  7 (AT  ZONE  LEVEL)  DSET7 

COMMON  /0SET7  / DSET7 

1 ZONE  ,HWAZ2  ,EZ  t M IK 2K Z , AN ALVZ » N STRAZ , H W A Z1  »EWAZ1  ,HWAZ3  JULY76 

. 2 tESTVZ  ,HWAZ12  ' • JULY76 

3 ,M1K2CL(10)  ,EPWCL(10)  ,EPW2CL(10)  fPKPICL(lO)  JULY76 

4 ,PK2CL(10)  - tPKCLdO)  ' ^SSO(lO)  JULY76 

INTEGER  ZONE  JULY76 

REAL  M1K2KZ,  MIK2CL'  • ' • ' ' ' ' JULY76 

DIMENSION  DSET7(81)  • • ' JULY76 

EQUIVALENCE  ( 0SET7 » ZONE  ) ' ‘ ' • ' ' ■ ' DSET7 

' DSET7 

CAS  DATA  SET  H (AT  REGION  LEVEL)  .OSET8 

COMMON  /DSET8  / ' ' USET8 

1 REGION, HWAR2  ,ER  , M 1 K2.KR  , AN  AL  V R , NZON  ES  , H W AR  1 ,EWAR1  ,ESTVR  JULY76 

2 ,M1M2ZR  , fills  (71  ) • > JULY76 

INTEGER  REGION  ‘ JULY76 

REAL  MIK2KR  . ■ ' ' . ■ ' JULY76 

DIMENSION  DSETBdO)  • JULY76 

E(0U  IVALENCE  ( DSET8, REGION  ) - ' ’ ’ DSET8 

DSET8 

CAS  DATA  SET  9 (AT  COUNTRY  • LEVE'L ) USET9 

COMMON  /0SET9  / ' . . 0SET9 

1 COUNTR,HWAC2  ,EC  , M I K2KC  , AN ALVC , M IM 2ZC , H W ACl  ,EWAC1  ,ESTVC  JULY76 

INTEGER  COUNTR  ' ■ > ' - ■ JULV76 

REAL  MIK2KC  JULY76 

DIMENSION  DSET9(9)  JULY76 

EQUIVALENCE  ( DSET9  , COUNTR  ) ■ . DSET9 

1 . USET9 

CAS  DATA  SET  11  (ZONE  DATA  — FINAL  PASS)  JULY76 

COMMON  /DSETll/  DSETll 

1 HWAZ  ,TWAZ  tEWAZ  ,AERRZ  ,AVARZ  ,TPR0DZ tEPRODZ , PRERRZ , PRVARZ  DSETll 

2 ,TYZ  ,EYZ  ,YERRZ  ,M1Z  ,M2Z  ,CT1Z  ,CT2Z  ,CT3Z  ,ANAVZ  DSETll 
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3 ,AMHKV2  USETIL 

REAL  Ml  7.  t M2Z  DSETIL 

DIMENSION  0SET1K19)  ' OSETll 

EQUIVALENCE  ( DSETU,HWAZ  ) DSETll 

C . DSETll 

C CAS  DATA  SET  12  (REGION  DATA  — FINAL  PASS)  . ■ JULY76 

COMMON  /DSET12/  DSET12 

1 HWAR  t-TWAR  ,EWAR  ,AERRR  tAVARR  , T PROOR  » E PROOR  t PR  ERRR  » PRV  ARR  USeT12 

2 tTYK  »EYR  ,YERRR  »M1R  ,M2R  ,CT1R  ,CT2R  ,CT3R  ,ANAVk  DSET12 

3 tANPRVR  DS6T12 

REAL  MIR  , M2R  . DSET12 

DIMENSION  DSET12(19)  USET12 

EQUIVALENCE  ( DSET12tHWAR  ) DSET12 

C DSET12 

C CAS  DATA  SET  13  (COUNTRY  DATA  — FINAL  PASS)  JULY76 

COMMON  /DSET13/  DSET13 

1 HWAC  ,TWAC  tEWAC  ,AERRC  ,AVARC  , TP RO DC , EPR ODC , PRE RRC , PRV ARC  DSET13 

2 tTYC  tEYC  tYERRC  »M1C  »M2C  rCFlC  ,CT2C  ,CT3C  ,ANAVC  DSET13 

3 T AMPRVCtCLEWA  , CL E PR D t CL  AT EC » CL  PTE C , CL  AT WC , CL PT WC  DSET13 

REAL  MIC  , M2C  DSET13 

DIMENSION  DSET13(23)  DSET13 

E(OUIVALENCE  ( DSET13»HWAC  ) DSET13 

C • . DSET13 

C file  DEFINITIONS  AND  RECORD  LENGTHS  . FILES 

COMMON  /FILES  / ' FILES 

1 SEGID  ,LSEGID»CR0PVI  ,LCROPW  t SU8HST  tLSUBH  tACOUlSrLACQ  FILES 

2 tCAMSF  tLCAMSF  tCAMERR  ,LCAMER,  CASF  ,LCASF  , YESOUTt'- YESO  FILES 

3 , SIGEXT ,LSIGEX,YESERRfLYESER  » SEGTRUtLSEGTR ,CASDIS  tLC ASD  FILES 

4 ,INP  ,OUTP  tTACrO  ,LTACQ  , CASDS  F , LC  ASDS  FILES 

INTEGER  SEGID  ,CROpw  , SURH ST » ACQU I S rC AMS F ,CAMERR»CASF  ,YESOUT  FILES 

1 tSIGEXT,YESERR, SEGTRUtCASDIStOUTP  ,TACO  ,CASUSF  FILES 

C • FILES 

C INDEX  RECORD  FOR  CAS  INTERMEDIATE  DATA  SET  FILE  (CASDSF)  IXCDSF 

COMMON  /IXCDSF/  IXCDSF 

1 IXCDSF( 1 ) tLIXCDS 

C IXCDSF 

C INDEX  RECORD  FOR  INTERMEDIATE  SUBSTRATA  HISTORICAL  DATA  FILE  1XSU8H 

' COMMON  /IXSUHH/  IXSUBH 

1 L IXSSH,  IXsilBH  ( 1 ) MODI 

C IXSUBH 

CUMMUN/FILESI/  FILES! 
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lISUBH2tLSUBH2,MXGLSS  FILESl 

C LEM  CCIMTROL  CARD  INPUT  DATA  LEMCM 

CUMMUN  /LEMCM  / ’ LEMCM 

1 TITLE(IO)  tICASE  t CUNTRY » MT R I AL ♦ RST ART , I PR  I N F » ST ARTR , START/  LEMCM 

2 ,ENOR  tENDZ  ,ISTG  tICAMS  ,IYES  tIACO  , I CL  ASS , I SF XT  , ISCC  LEMCM 

3 ,ICAS2  ,ICAS3  t I PRC AM , I PR YES  , I PRCAS » I CS ESG  , I CS ECW , ICSESH , IC SEC E LEMCM 

4 t ICSEYM, ICSES E, ICSE AC, RSEEDl, RSEED2, RSEED3, RSEE04, RSE EOS, RSEED6  LEMCM 

5 ,KSEED7,ICSEST,ICSEC0,ICSEYS  ,ICSECIJ,ICSECD  LEMCM 

DIMENSION  RSEED(7)  LEMCM 

DOUBLE  PRECISION  R5EED  , RSE ED  1 , RSE ED2 , RS EED3 , RS EE04 , RSEEOS  LEMCM 

1 , RSEFD6, RSEED7  ’ , LEMCM 

EDUIVALENCE  ( RSEEn,RSEEDl  ) LEMCM 

INTEGER  KSTART, STAKTR , START/ , ENDR  , END/  LEMCM 

•C  ■ LEMCM 

C SUBSTRATA  HISTORICAL  DATA  FROM  SlJBHST  FILE  ' SSHDTA 

COMMON  /SSHDTA/  SSHDTA 

1 CUUN2  ,IKEG2  , I ZONE/ , I STR A2 , I SU BS 2 , NSEG  ,IDSEG  ,GRPNO  ,HISTPW  SSHDTA 

2 ,AREAK  ,PWK  ,NAGR  ,NA  , DELT PW , OELTP M , C V 1 ,CV2  ,CV3  SSHDTA 

3 ,CV4  , VMULTK, CLASS! 18 ) ,MXK, RDSSH  JULY76 

INTEGER  GRPNO  , CLASS  , RDSSH  JULY76 

DIMENSION  SSHDTA(39)  JULY76 

EQUIVALENCE  { SSHDTA,  COUN2  ) SSHDTA 

SSHDTA 

STATISTICAL  INFORMATION  FOR  LEM  STATS 

COMMON  /STATS  / STATS 

1 ITER  ,NSEGTR,NCAMSR,NYESR  ,NREC ( 7 ) ,NCASCR ,NCASDR  STATS 

EQUIVALENCE  ( NT,  ITER  ) STATS 

STATS 

DEBUGGING  PRINT  FLAG  CASPP 

COMMON  /DEBUGF/  DEBUGF  . CASPP 

CASPP 

YIELD  DATA  FROM  YESOUT  FILE  YESDTA 

CUMMUN  /YESDTA/  YFSDTA 

1 YSTR  ,IZPRDD(6)  ,YSCI(6)  ,VSYCI(6)  YESDTA 

2 ,kOYES  ,NYESPP  YESDTA 

INTEGER  RDYES  -YESDTA 

YESDTA 
CASPP 

INITIALLY  POSITION  FILES  YESOUT,  SlJBHST,  AND  CAMSF  AS  SPEC  I F I EDCASP  P 
BY  STARTR  AND  START7.  ALSO  INITIALIZE  FLAGS  AND  COUNTERS.  CASPP 

IPP=  IPP  + 1 CASPP 
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CALL  CASINL  CASPP 

ON  THE  FIRST  ITERATION  CALL  CLASSN  FOR  EACH  PREDICTION  POINT  J.ULY76 

TO  DETERMINE  THE  CLAS’S  NUMBER  FOR  EACH  SUBSTRATA  JULY76 

IF  { NT  .EG.  NSTART  ) CALL  CLASSN  JULY76 

NKSSH  =0  ■ ■ JULY76 

CASPP 

INITIALIZE  DATA  SET  9 (COUNTRY  LEVEL)  CASPP 

DO  1X0  1 = ?.  ,LDS9  • CASPP 

DSET9 ( I )=  0.0  CASPP 

no  CONTINUE  . ■ CASPP 

ENDC=  0 , CASPP 

TWAC=  0.0  ' CASPP 

CASPP 

INITIALIZE  DATA  SET  8 (REGION  LEVEL)  CASPP 

120  DU  130  I=1,LDS8  ' CASPP 

DSETB(  n=  0,0  . CASPP 

130  CONTINUE  CASPP 

ENDREG=  0 CASPP 

TWAR=  0.0  CASPP 

CASPP 

INITIALIZE  DATA  SET  7 (ZONE  LEVEL)  CASPP 

140  DO  150.I  = 1,LDS7  CASPP 

DSET7 ( I )=  0.0  CASPP 

150  CONTINUE  • • CASPP 

ENDZUM=  0 CASPP 

TWAZ=  0.0  , CASPP" 

CASPP 

INITIALIZE  DATA  SETS  4,5r  AND  6 (STRATA  LEVEL)  CASPP 

160  DO  no  I = 1,LDS4  CASPP 

DSET4(I)=  0.0  CASPP 

170  CONTINUE  CASPP 

KSU6=  0 ^'ASPP 

CASPP 

READ  STRATA  YIFLD  DATA  FROM,  YESDUT  AND  SELECT  THE  PROPER  VALUE  CASPP 

OF  ESTIMATED  YIELD  FOR  THE  CURRENT  BIOWINDOW  OR  PREDICTION  DATECASPP 
CALL  GETYS  ■ CASPP 

IF  ( NFATAL  ,NE.  0 ) GO  TO  990  CASPP 

IF  ( YSTR  ,LT.  0.0  ) ' GO  TO  550  ’ CASPP 

CASPP 

SHOULD  WE  READ  SUBHST  THIS  TIME  OR  IS  SUBSTRATA  DATA  ALREADY  CASPP 

READ  IN  AND  WAITING  FOR  PROCESSING  CASPP 
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IF  ( KDSSH  .EO.  0 ) GD  TH  210  CASPP 

SUBSTRATA  DATA  ALREADY  READ  I^S.  SET  RDSSH  FLAG  TO  READ  SUBHST  CASPP 
NEXT  TIME.  ■ ' CASPP 

RDSSH=  0 . CASPP 

GO  TO  250  . CASPP 

CASPP 

READ  NEXT  SUBSTRATA  RECORD  FROM  .ISUBH2  FILE  JULY76 

210  NRSSH=  NRSSH  + 1 JULYT6 

CALL  RANACF  ( I SU BH2 ♦ NR S SH , S SHOT  A , L SU BH2 , I X SUBH » L I XSSH , 1 ) JULY76 

NCLASS=‘  CLASS  (IPP  ) ' JULY76 

CASPP 
CASPP 

TEMPORARY  DEBUGGING  PRINTOUT  CASPP 

CASPP 
CASPP 
CASPP 

TEST  FOR  END  OF  COUNTRY  ON  ISUBH2  FILE  JULY76 

IF  ( C0UN2  .EO.  6NDFIL  ) GO  TO  400  CASPP 

C CHECK  FOR  NEW'REGION,  ZONE,  OR  SUBSTRATA  CASPP 

IF  ( IREG2  .NE.  REGION  ) GO  TO  430  ‘ CASPP 

IF  ( IZ0NE2  .ME.  ZONE  ) GO  TO  440  CASPP 

IF  ( IS.TRA2  .ME.  STRATA)  GO  TO  450  CASPP 

C CASPP 

C . SKIP  OVER  GRPNO,  NAGR,  NA,  AMD  HISTPW  CHECKS  IF  NOT  FIRST  CASPP 

C ITERATION  FOR  THIS  RUN.  ' CASPP 

250  IF  { NT  .NE.  NSTART  ) GO  TO  290  CASPP 

IF  ( GRPNO  .GT.  0 .AND.  GRPNO  .LT.  4 ) GO  TO  260  CASPP 

C illegal  group  number  (MUST  BE  1,2,  OR  ‘3)  CASPP 

CALL  ERRMES  ( 3HC AS , 5HC ASPP , R , 1 ) CASPP 

GO  TO  990  CASPP 

C CASPP 

260  IF  ( NAGR  .EO.  0 ) GO  TO  270  fA«;pp 

IF  ( NA  .NE.  0 ) GO  TO  2R0  CASPP 

C . CASPP 

C NAGR=  0 OR  NA=  0.  PRINT  WARNING  AND  SET  GROUP  NO.  = 3 CASPP 

270  CALL  ERRMES  ( 3HCA S , 5HC A S P P , 9 , 0 ) CASPP 

GRPN0=  3 CASPP 

C ‘ ■ CASPP 

280  IF  { GRPNO  ‘.E(0.  3 ) GO  TO  290  CASPP 

IF  ( HISTPW  .GT.  0,0  ) GO  TO  290  CASPP 

C ERROR.  HISTPW  .LE.  0.0  AND  GRPNO  = 1 OR  2 • CASPP 
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CALL  EkRMES  { 3HC A S t 5HC ASPP , 15 , 0 ) CASPP 

GRPNU=  3 CASPP 

C ' ■ ■ CASPP 

C GENERATE  DATA  SETS  1,2,  AND  3 'AT  THE  SUBSTRATA  LEVEL.  CASPP 

290  CALL  DS123  CASPP 

IF  ( NFATAL  ,NE.  0 ) GO  TO  990  • “ CASPP 

C CASPP 

GO  TO  210  • ' CASPP 

CASPP 

END  OF  DATA  ON  SUHHST  (COUNTRY  = 4HZZZZ)  CASPP 

SET  END  OF  COUNTRY  FLAG  . CASPP 

400  ENDC  = 1 • JULY76 

SET  END  OF  REGION  FLAG  ' CASPP 

430  ENOREG=  1 • CASPP 

SET  END  OF  ZONE  FLAG  CASPP 

440  ENDZON=  I-  CASPP 

END  -OF  STRATA.  SET  RDSSH  TO  SKIP  READING  SUBHST  NEXT  TIME  CASPP 

450  RDSSH=  1 CASPP 

CASPP 

FINISH  PROCESSING  DATA  SET^  4,  5,  AND  6.  CASPP 

CALL  DS45B  CASPP 

IF  ( NFATAL  .ME.  0 ) GO  TO  990  • CASPP 

CASPP 

550  IF  ( ENDZON  .EQ.  0 ) GO  TO  160  . CASPP 

CASPP 

END  OF  ZONE  CASPP 

FINISH  PROCESSING  DATA  SET  7 (ZONE  LEVEL)  CASPP 

CALL  DS7  ’ ■ ■ CASPP 

IF  ( NFATAL  .NE.  0 ) GO  TO  990  CASPP 

CASPP 

IF  ( ENDREG  .EO.  0 ) GO  TO  140  CASPP 

CASPP 

END  OF  REGION  CASPP 

GENERATE  REST  OF  DATA  SET  8 (EQ.  77  — REGION  LEVEL)  CASPP 

IF  ( HWARl  .NE.  0.0  ) ER=  EWARl/HWARl  CASPP 

CASPP 

WRITE  DATA  SET  8 ONTO  INTERMEDIATE  FILE  CASPP 

IRREG  = IRREG  + 1 • CASPP 

NKEGS  = NREGS  + 1 CASPP 

CALL  R.ANACF  { C ASDS  F , I RR  EG  , 0 SE  T 8 , LC  A SD  S , I X CDSF  , L I XC  DS  , 2 ) CASPP 

C CASPP 
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c AGGREGATE  REGION  DATA  SET  8 UP  TO  DATA  SET  9 (COUNTRY  LEVEL)  CASPP 


C EGNS.  80-86tB8,89  CASPP 

TWAC=  TWAC  + TWAR  ' CASPP 

DU  820  1=2,5  V " ■ JULY76 

DSET9(I)=  nSET9(I)  + DSET8(I)  CASPP 

820  CONTINUE  • CASPP 

M1M2?.C=  M1M2ZC  + M1H2ZR  , CASPP 

HWACl  = HWACl  + HWARl  ' CASPP 

EWACl  = EWACl  + EWARl  . \ CASPP 

IF  { ENDC  .EO.  0 ) GO  TO  120  CASPP 

CASPP 

END  OF  COUNTRY  ’ , . CASPP 

GENERATE  REST  OF  DATA  SET  9 (ECO.  87  — COUNTRY  LEVEL)  CASPP 

IF  ( HWACl  .NE.  0.0)  EC=  EWACl/HWACl  CASPP 

CASPP 
JULY76 

COMPUTE  ESTIMATED  GROUP  1,2  VARIANCE  OF  ALL  STRATA  WITH  . JULY76 

ACCOUIRED  segments  • • JULY76 

CALL  CAS2  JULY76 

C JULY76 

C GENERATE  DATA  SET  10-19  ON  FINAL  PASS  FOR  EACH  PREDICTION  P0INTJULY76 

CALL  CAS3  JULY76 

990  RETURN  CASPP 

END  . CASPP 
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IS  CAS2 

SU6RC)iJTINE  CAS2  CAS2 

CUMRUTES  THE  AREA  VARIANCE  AND  ANALYTIC  AREA  VARIANCE  OF  JULY76 

ALL  STRATA  WITH  ACQUIRED  SEGHETNTS  AND  ACCUMULATES  QUANTITIES  JULY76 
AT  THE  ZONEj  REGION,  AND  COUNTRY  LEVELS  WHICH  WILL  BE  USED  JULY76 

TO  COMPUTE  THE  VARIANCE  OF  STRATA  WITHOUT  ACQUIRED  SEGMENTS  JULY76 

AND  ALSO  THE  AREA  VARIANCES  AT  THE  ZONE,  REGION,  AND  . JULY76 

• COUNTRY  levels.  JULY76 

CAS2 

ARGUMENT  LIST  FOR  ERROR  PROCESSING  ■ • ' ARGLST 

COMMUN  /ARGLST/  . ARGLST 

1  NERRS  ,NFATAL,NPERRS,NARG  ,ARG(10>  ARGLST 

DIMENSION  lARG(lO)  ARGLST 

EQUIVALENCE  ( IARG,ARG  ) ARGLST 

‘ARGLST 

CAS  CONTROL  CARD  INPUT  DATA  AND  CONSTANTS  ‘ CASCM 

COMMON  ■ /CASCM  / CASCM 

1 AREACF,YCF  ,PRDCF  , APRIJTS  ( A , 2 ) ,PPRUTS(5,2)  ,YPRUTS(3,2)  CASCM 

2 , AKEAPS, S2MAX  ,NHISTY,HH  ,TOPT  , AUN I TS , D I ST FF , B WI ND ( 4 ) CASCM 

3 ,WPRI0R(4)  ,APREP  ,IPRD(3,14)  ,NPDATE , PROATE ( 14 ) CASCM 

INTEGER  -HH,  TOPT,  AU M I TS , D I STF>  , B W I ND , WPR I OR , APR EP , PRDAT E CASCM 

CASCM 

DATA  BLOCK  FOR  CAS  CUMULATIVE  FILE  CASCUM 

CAS  DATA  SETS  14,  -15,  16,  AMO  17  - ‘ CASCUM 

COMMUN  /CASCUM/  CASCUM 

1  CASCUM(32),  BUFFR(504)  CASCUM 

DIMENSION  ICASC(32),  DSET14(22),  DSET15{22),  DSET16(22)  CASCUM 

1 ,DSET17(28)  CASCUM 

EQUIVALENCE  ( ICASC, CASCUM  ) CASCUM 

EQUIVALENCE  ( DSE T14 , DS ET 1 S , D SET  16 ,D SET  1 7 , C ASCUM ( 5 ) ) CASCUM 

1 , ( SOAERS,SOAERZ,SOAERR,SOAERC, CASCUM (24)  ) CASCUM 

2 , ( SOPERS, SOPERZ,SQPERR,SOPERC,CASCUM(  25)  ) C Ac;r.UM 

3 , ( SOYERS,SOYERZ ,S0YERR,S0YERC,CASCUM(26 ) ) CASCUM 

CASCUM 

FLAGS  AND  COUNTERS  FOR  CAS  SIMULATOR  CASFLG 

COMMON  /CASFLG/  CASFLG 

1 H ,PPFLG  ,N6W  ,IBW  , WINDOW, IPD  ,IPP  , P PD AT E , NREGS  CASFLG 

2 ,NZTOT  ,NSTRAT  ,NYESSK,NSSHSK,NC'AMSK,NRYES  ,NRSSH  ,NRCAMS  CASFLG 

3 ,ENDC  ,ENDREG,FNDZGN, IRSTR  , I RZON E , I RRE G CASFLG 

4 ,LDS1  ,LDS4  ,LDS7  ,LDS8  ,LDS9  ,LDS10  ,LDS11  ,LDS12  ,LDS13  CASFLG 

5 ,LDS14  ,LDS15  ,LDS16  ,LDS17  , L RC OU N , L RRE G , L RZONE , L RSTR  CASFLG 


hi  ro 
JU  03 
cm  CO 
D ^ 

I 

ON  o 
nO 


a 

, 

U1 


REPRODUCIBILITY  OP  THE 
ORIGINAL  PAGE  IS  POOR' 


IMT6GEK  PPFLG  , WINDOW  » PPDATE  CASFLG 

C CASFLG 

C ' CONTROL  parameters  FOR  LFM  PROGRAM  CNTRL 

COMMON  /CNTRL  / ' CNTRL 

1  PKINTF,NSTAKT,SEED(7  ) CNTRL 

INTEGER  PRINTF  CNTRL 

DOUBLE  PRECISION  SEED  CNTRL 

, C . ■ . CNTRL 

C CONSTANT  QUANTITIES  FOR  LEM  PROGRAM  CONST 

COMMON  /CONST  / CONST 

1  NTRMX  ,MAXR  ,MAXZ  , I M XS EG, E NDF I L t I TSF G CONST 

C ’ CONST 

CrjMMUN/FILESl/  FILESI 

I ISUBH2 ,LSUBH2 ,MXCLSS  FILESI 

C CAS  DATA  SETS  1,2,  AND  3 • ' DSETl 

COMMON  /DSETl  / DSETl 

1 ISUhST,TWAK  ,HWAK  ,EWAK  ,M1K  ,CT1K  ,ANALVK,EPWK  ,EPW2K  JULY76 

2 ,SMPKPI  ,SIJMPK2,SUMPK  ,KSUB  ,NCLASS  ■ ’ JULY76 

REAL  MIK  , M2K  JULY76 

DIMENSION  0SETK14),  nSET2(14),  DSET3(6)  JULY76 

EQUIVALENCE  ( DSET 1 , OSET2 , D SET 3 , I SO BS T ) DSETl 

1 , ( M2K,M1K  ),  ( CT2K,CT3K,CTIK  ) DSETl 

C DSETl 

C CAS  DATA  SETS  4,  5,  AND  6 (AT  STRATA  LEVEL)  DSET4 

COMMON  /DSET4  / ‘ DSET4 

1 STRATA, TWASl  ,HWASl  ,EWAS1  ,XM1JS  ,XCT1S  ,AMVS1  JULY76 

2 ,TWAS2  ,HWAS2  ,EWAS2  ,XM2JS  ,XCT2S  ,ANVS2  ,T  JULY76 

3 ,TWAS3,HWAS3,XCT3S 

4 ,XYS  ,XESTYS , EVYRS  , P2 I DPK , V IV 2S  ,VARS  , ANVARS  JULY76 

5 ,FILL4(57) 

INTEGER  STRATA  JOLY76 

DIMENSION  0SET4(24),  DSET5(7'),  DSeT6(3)  JULY76 

EQUIVALENCE  ( DSET4, STRATA  )|,  ( DSET5,TWAS2  ),  { DSET6,TWAS3  ) DSET4 

C DSET4 

C CAS  data  SET  7 (AT  ZONE  LEVEL)  DSET7 

COMMON  /DSET7  / DSET7 

1 ZUNE  ,HWAZ2  ,EZ  , M1K2KZ , ANALV Z , NSTR AZ, HWAZ 1 ,EWAZ1  ,HWAZ3  JULY76 
'2  ,ESTVZ  ,HWAZ12  JULY76 

3 ,MlK2CL(lb)  ,EPWCL(1Q)  ,EPW2CL(10)  ,PKPICL(10)  JULY76 

4 ,PK2CL(10)  ,PKCL(10)  ,SS(D(10)  ' ' JULY76 

INTEGER  ZONE  JULY76 
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REAL  MlK2KZt  M1K2CL  JULY76 

DIMENSION  0SET7(81)  JULY76 

EQUIVALENCE  ( DSET7tZ0NE  ) ' DSET7 

C ■ IJSET7 

C CAS  DATA  SET  8 (AT  REG-IOM  LEVEL)  DSET8 

COMMUM  /OSET8  / DSET8 

L REGION, HWAR2  ,ER  , Ml K2KR , AN ALV R, NZON ES , HWAR 1 ^EWARl  ,ESTVR  JULY76 

2 ,M1M2ZR,FILL8(71 ) ’ JULY76 

INTEGER  REGION  ' JULY76 

REAL  M1K2KR  ■ JULY76 

DIMENSION  DSETBdO)  . J-ULY76 

EQUIVALENCE  ( DSET8, REGION  ) DSET8 

nsETa 

CAS  DATA  SET  9 (,AT  COUNTRY  LEVEL)  • DSET9 

COMMON  /0SET9  V USET9 

1 COUNTR,HWAC2  ,EC  ,M1K2KC , ANALVC ,M 1M2ZC  ,HWAC1  ,EWAC1  ,ESTVC  JULY76 

INTEGER  COIIMTR  • JULY76 

REAL  M1K2KC  JULY76 

DIMENSION  DSET9I9)  JULY76 

EQUIVALENCE  { DSET9,C0UNTR  ) DSET9 

DSET9 

CAS  DATA  SET  11  (ZONE  DATA  — FINAL  PASS)  JULY76 

COMMON  /DSETll/  DSETll 

1 HWAZ  ,TWAZ  ,EWAZ  ,AERRZ  ,AVARZ  ,T PR DDZ , EPRODZ , PR ERRZ , PR VARZ  DSETll 

2 ,TYZ  ,EYZ  ,YERRZ  ,M1Z  ,M2Z  ,CT1Z  ,CT2Z  ,CT3Z  ,AMAVZ  DSETll 

3 ,ANPKVZ  DSETll 

REAL  MIZ  , M2Z  DSETll 

DIMENSION  DSETll (19)  DSETll 

E(0UIVALENCE  ( DSETll, HWAZ  ) ' DSETll 

DSETll 

CAS  data  SET  12  (REGION  DATA  — FINAL  PASS)  JULY76 

COMMON  /DSET12/  ' DSET12 

1 HWAR  ,TWAR  ,EWAR  ,AERRR  ,AVARR  , TPRODR , EPRODR , PRE RRR , PRVARR  DSET12 

2 ,TYR  ,EYR  ,YERRR  ,M1R  ,M2R  ,CT1R  ,CT2R  ,CT3R  ,ANAVR  DSET12 

3 ,AMPRVR  . DSET12 

REAL  MIR  , M2R  ' DSET12 

dimension’  DSFT12(19)  . DSET12 

EQUIVALENCE  ( DSET12,HWAR  ) DSET12 

DSET12 

CAS  DATA  SET  13  (COUNTRY  DATA  — FINAL  PASS)  ' JULY76 

COMMON  /DSET13/  DSET13 


28234-6029-RU-51 
Page  417 


OO  oo  oo  -OO 


1 HWAC  ♦TWAC  ,EWAC  ,AERRC  , AVARC  , TPRCIDC , EPRQUC,  PRE  RRC  t PRVARC  DSET13 

2 »TYC  tEYC  tYERKC  ,MLC  tM2C  ,CT1C  tCT2C  ,CT3C  ,ANAVC  056X13 

3 t ANPKVC,CLEWA  , CL EP RD , CL AXE C t CL  PTE C , CL  AT WC , CL  PI WC  , DSEX13 

REAL  MIC  f M2C  ' DSETIS 

DIMENSION  DSET13I25I  0SEX13 

EOUIVALENCE  ( DSEX13,HWAC  ) 056X13 

0SEX13 

FILE  DEFINITIONS  AND  RECORD  LENOTHS  FILES 

COMMON  /FILES  / FILES 

1 SEGIO  ,LSEGlDtCROPW  tUCROPW  , SUBHSX  ,L  SUBH  , ACOUI S »LA'CQ  , FILES 

2 ♦CAMSF  ,LCAMSF ,CAMERR,LCAMER,CASF  ,LCASF  , YE SOUX , L YE SO  FILES 

3 tS IGEX  r , LSI GEXr YES  ERR, LYE SER  r SECT RU  tLSEGXR  T CAS DIS,LCASD  FILES 

A ,INP  ,‘OUXP  ,XACO  ,LXACO  , C ASDS  F , L C ASDS  FILES 

INTEGER  SEGID  ,CR0PW  , SUBHSX , ACOU I S, CAMSF  ,CAMERR,CASF  ,YES0UX  FILES 

1 , SIGEXTtYESEKR,  SEGXKUtCASDIS,  DllTP  ,TACO  ,CASDSF  FILES 

FILES 

INDEX  RECORD  FOR  CAS  CUMULATIVE  FILE  (CASE)  IXCASF 

COMMON  /IXCASF/  IXCASF 

1  IXCASF! 1 ) ,L IXCAS 

IXCASF 

INDEX  RECORD  FOR  CAS  INTERMEDIATE  DATA  SET  FILE  (CASDSF)  IXCDSF 

COMMON  /IXCDSF/  IXCDSF 

1 IXCDSF! 1 ) ,L IXCDS 

IXCDSF 

INDEX  RECORD  FOR  INTERMEDIATE  SUBSTRATA  HISTORICAL  DATA  FILE  IXSUBH 
COMMON  /IXSUBH/  , IXSUBH 

1 L IXSSH, IXSUBH ! 1 ) MODI 

C • , IXSUBH 

C . LEM  CONTROL  CARO  INPUT  DATA  LEMCM 

COMMON  /LEMCM  / • LEMCM 

1 TlTLEllO)  riCASe  ,CUNTRY,NTRIAL,RSTART, IPRINT,STARTR,STARTZ  LEMCM 

2 ,ENDR  ,ENDZ  ,ISTG  ,ICAMS  ,IYES  rIACO  , I CLASS , I S EXT  ,ISCC  ' ' i^'MCM 

3 ,ICAS2  ,ICAS3  , I PRCAM , I PRY ES , I PRC AS , I C SE SG, I CSECW, I CSESH , I CSECE  . LEMCM 

4 , ICSEYM, ICSES6, ICSFACtRSEEDI rRSEED2 ,RSEED3 ,RSEED4,RSEED5»RSEED6  LEMCM 

5 ,RSEED7, ICSEST, ICSECO, ICSEYS, ICSECU, ICSECD  LEMCM 

DIMENSION  RSEED(7)  - LEMCM 

DOUBLE  PRECISION  RSEED  , RSEEDl , RSEE D2 , RSE E D3 » RSE ED4 , RSEED5  LEMCM 

1 ,RS6E06 ,RSEED7  ' ’ ■ LEMCM 

EOUIVALENCE  I RSEED, KSEEDl  ) LEMCM 

INTEGER  RSTART,STARTR,STARTZ, ENDR  »ENDZ  LEMCM 

C LEMCM 
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C PAGE  EJECT  CONTROL  .PARAMETERS  FOR  LEM 

COMMON  /PAGECM/ 

1  NPAGE  tNLlNE  , MXL I NE r NS TTL  tSUBTTL(IO) 

STATISTICAL  INFORMATION  FOR  LEM 
COMMON  /STATS  / 

1  ITER  tNSEGTK,NCAMSR»NYESR  , NREC { 7 ) , NCASCR , MCASDR 
EOIJIVALENCG  ( NT,  ITER  ) 

SUBSTRATA  HISTORICAL  DATA  FROM  SUBHST  FILE 
COMMON  /SSHDTA/ 

1 C0UN2  ,1REG2  , 1 ZONE 2 , I ST RA2 , I SU BS2 , N SEG  , I DS EG  ,GRPNO 

2 ,AKEAK  ,PWK  ,NAGR  ,NA  , DELTPW , DELTPM, CVl  ,CV2 

3 ,CV4  , VMULTK, CLASS ( 18  ) ,MXK  ,RDSSH 

INTEGER  GRPNO-t  CLASS  , RDSSH 
DIMENSION.  SSHDTA (39) 

EOU I VALENCE  ( SSHDTA,  C0UN2  ) 

debugging  print  flag 

COMMON  /DEBUGF/  OEBOGF 


LOCAL  VARIABLES 

I DO  LOOP  INDEX 

IREG  REGION  INDEX  ( 1 , 2 , . . . , NREG ) 
HOME  ZONE  INDEX  ( 1 , 2 , . . . , NZDNE S ) 


IF  ( M1K2KC  .NE.  0.0  ) GO  TO  110 
C ■ . 

CALL  PAGER  (3) 

WRITE  (OUTPrl) 

1 FORMA!  (//28H  NO  ACQUISITIONS  IN  COUNTRY) 

IF  ( PPFLG  ,NE.  0 ) GO  TO  105 

WRITE  (0UTP,2)  I8W 

2 FORMAT  (16H  FOR  BIOWIMQOW  ,12) 

GO  TO  990 

105--  WRITE  (0UTP,3)  I PRO  ( 2 , 1 PD  ) , I PRD  ( 3 , I P D ) , I PRD  ( I , I P D ) 

3 FORMAT  ■(22H  FDR  PREDICTION  DATE  , I 2 , IH/ I 2 , IH/ I 2 ) 

GO  TO  990 


PAGECM 

PAGECM 

PAGECM 

PAGECM 

STATS 

STATS 

stats 

STATS 

stats 

SSHDTA 
SSHDTA 
, HISTPV'!  .SSHDTA 
,CV3  SSHDTA 
JULY76 
JULY76 
JULY76 
SSHDTA 
SSHDTA 
CAS2 
CAS2 
CAS2 
CAS2 
CAS2 
CAS2 
CAS2 
CAS2 
CAS2 
CAS2 
CAS2 
CAS2 
CAS2 
CAS  2 
CAS2 
CAS2 
CAS2 
CAS2 
CAS2 
CAS  2 
CAS2 
CAS2 
CAS2 
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. INITIALIZE  REGION^  ZONE,  AND  STRATA  POINTERS  FOR  CAS  CAS2 

intermediate  file.  ( REGION  RECORDS  ARE  3-12,  ZONE  RECORDS  ARE  CAS-2 
13-62,  STRATA  RECOROS'ARE  63-387  ) CAS2 

110  IRREG=  2 ■ CAS2 

IKZ0NE=  12  CAS2 

IRSTR  = 62  CAS2 

IREG=  0 CAS2 

NRSSH  = 0 JULY76 

JULY76 

REGION  LOOP  JULY76 

140  IREG  = IREG  + 1 JULY76 

IZOME=  0 . CAS2 

CAS2 

READ  DATA  SET  8 (REGION  LEVEL)  FROM  CAS  INTERMEDIATE  FILE  CAS2 

IKKEG=  IRREG  + 1 CAS2 

CALL  RANACF  ( C ASDS  F , I RR  E G,  0 SET  8 , LC  ASDS  , J X CD  S F , L I XCD  5 , 1 ) --CASZ 

CAS2 

' .ZONE  LOOP  - ' JULY76 

180  IZONE  = IZONE  + 1 CAS2 

CAS2 

READ  DATA  SET  7 (ZONE  LEVEL)  FROM  CAS  INTERMEDIATE  FILE  CAS2 

IRZONE=  IRZONE  + 1 CAS2 

CALL  RANACF  ( C AS DS F , I RZONE , DSET 7 , L CASDS , I X CDSF , L I XCDS , 1 ) CAS2 

CAS2 

ISTRAZ  = 0 JULY76 

JULY76 

STRATA  LOOP  ' JULY76 

200  ISTRAZ  = ISTRAZ  + 1 . JULY76 

READ  DATA  SETS  4,5,  AND  6 FROM  CAS  INTERMEDIATE  FILE  JULY76 

IRSTR  = IRSTR  +. 1 JULY76 

CALL  RANACF  ( CAS DSF , I R STR , DSET4 , LC AS DS , IXC DSF , L I X CDS , 1 ) JULY76 

P'l!  Y76 

V1V25  = 0,0  JULY76 

NSUB  = XCTIS  + XCT2S  + XCT3S  + 0.01  JULY76 

ISUB  = 0 JULY76 

JULY76 

SUBSTRATA  LOOP  JULY76 

READ  SUBSTRATA  DATA  FROM  ISUBH2  FILE  JULY76 

220  ISUB  = ISUR'  + 1 JULY76 

NRSSH  = NRSSH  + 1 ■ JULY76 

CALL  RANACF  ( I SUBH2  ,MRSSH , SSHDTA, L SUBH2 , IXSUBH ,L I XSSH , 1 ) JULY76 
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JULY76 

NCLASS=  CLASS(IPP)  JULY76 

JULY76 

JULY76 

J0LY76 

JULY76 

• IF  CLASS  NUMBER  I.S  ZERO  OR  IF  NO  ACOUIRED  SEGMENTS  IN  STRATA,  JULY76 


• SKIP  THIS  SUBSTRATUM.  JULY76 

IF  ( NCLASS  .EO.  0 ) .GO  TO  250  JULY76 

IF  ( M1K2KZ  .LT.  2.0  ) GO  TO  250  JULY76 

IF  ( XMIJS  + XM2JS  .EO.  0.0  ) GO  TO  250  . JULY76 

JULY76 

IF  ( GKPNO  - 2 ) 240,230,250  , JULY76 

GROUP  2 SUBSTRATA.  FINISH  COMPUTING  GROUP  2 VARIANCE  MULT  I PL  I ER  J.ULY76 
230  IF  ( XM2JS  .EO.  0.6  ) GO  TO  250  JU1Y76 

VMULTK  = ’VMULTK=^‘HWAS2/XM2  JS  . JULY76  ' 

GROUP  1 OR  GROUP  2 SUBSTRATA  JULY76 

240  V1V2S  = V1V2S  + VMULTK^=SSQ  ( NCLASS ) ■ JULY76 

TEST  FOR  END  OF  STRATUM  JULY76 

250  IF  { ISUB  .LT.  NSUB  ) GO  TO  220  JULY76 

JULY76 

IF  NO  ACQUIRED  SEGMENTS  IN  STRATUM  OR  IF  LESS  THAN  2 SEGMENTS  JULY76 
IN  ZONE,  SKIP  VARIANCE  CALCULATIONS  FOR  STRATUM.  . JULY76 

(COMPUTED  LATER'  IN  SUBROUTINE  DSIO)  JULY76 

IF  { M1K2KZ  .LT.  2.0  ) GO  TO  260  JULY76 

IF  ( XMLJS  + XM2JS  .EQ.  0.0  ) GO  TO  260  JULY76 

COMPUTE  AREA  VARIANCE  FOR  STRATA  WITH  ACOUIRED  SEGMENTS.  JULY76 

V1V2S  = V1V2S  + T , JULY76 

ANVS2  = AMVS2  + T JULY76 

TAU2S  = ( 1.0  + HWAS3/IHWAS1  + HWAS2')  )>!«':' 2 JULY76 

•VARS  = TAU2S-V1V2S  JULY76 

ANVARS=  TAU2S-MANVS1  + ANVS2)  >"'IY76 

- , JULY76 

WRITE  STRATA  RECORD  BACK  ONTO  CASDSF  , JULY76 

CALL  RANACF  ( CASDSF , I RSTR , DSET4 , LC AS  OS , IXC DSF , L I XCDS , 2 ) JULY76 

ESTVZ  = ESTVZ  + V1V2S  JULY76 

ANALVZ=  ANALVZ  + ANVSl  + ANVS2  ‘ JULY76 

GU  TO  265  * • JULY76 

JULY76 

COMPUTE  TOTAL  WHEAT  AREA  FOR  STRATA  WITHOUT  SEGMENTS  JULY76 

UR ’for  strata  in  a zone  WITH  LESS  THAN  2 ACQUIRED  SEGMENTS.  JULY76 
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260  HWAZ3  = HWAZ3  + HWASl  + HWAS2  + HWAS3 
C 

265  CONTINUE 


TEST  FOR  END  OF  ZONE 

270  IF  ( ISTRAZ  .LT.'nSTRAZ  ) GO  TO  200 


276  CONTINUE 


WRITE  DATA  SET  7 BACK  ONTO  CAS  INTERMEDIATE  FILE  (CASDSF) 
CALL  RANACF  ( C AS DSF » I RZONE , DSET 7 , L C A SOS , I X COS F , L I XCDS , 2 ) , 

IF  ( MTK2KZ  ,LT.  2.0  ) GO  TO  280 
ESTVR  = ESTVR  + ESTVZ 
AMALVK=  ANALVR  + ANALVZ 
TEST  FOR  END  OF  REGION 
280  IF  ( IZOME  .LT,  NZONES  ) GO  TO  180 


IF  ( M1M2ZR  .EO.  0 ) GO  TO  290 

WRITE  data  set  8 BACK  ONTO  CASDSF 
CALL  RANACF  ( C ASDS F , I RREG t D SET 8 , LC ASDS » I XCDS F , L I XCD S , 2 ) 
eSTVC  = ESTVC  + ESTVR 
ANALVC  = ANALVC  + ANALVR 

TEST  FOR  END  OF  COUNTRY 
290  IF  ( IREG  .LT.  NREGS  ) GO  TO  140 


990  ■ RETURN 


END 


JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY 76 

JULY76 

JULY76 

JULY 76 

JULY76 

JDLY76 

CAS2 

CAS2 

CAS2 

CAS2 

CAS2 
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FUR, 


IS  CAS3 

SUBROUTINE  CAS3 

generates  data  sets  iO-17,19  USING  DATA  SETS  1-9  READ  FROM 
THE  CAS  IMfERMEDIATE  FILE. 


ARGUMENT  LIST  FOR  ERROR  PROCESSING 
CUMMUN  /AKGLST/ 

1  NERRS  >NFATAL,NPERRS ,NARG  ,ARG(10) 
DIMENSION  lARG(lO) 

EOUIVALEMCE  ( IARG,ARG  ) 


CAS  CONTROL  CARD  INPUT  DATA  AND  CONSTANTS 
CUMMUN  /CASCM  / 

1 AREACF,YCF  ,PRDCF  rAPRUTS(4,2)  ,PPRUTS(5,2)  ,YPRUTS{3t2) 

2 , AREAPS,S2MAX  ,NHISTY,HH  ,TOPT  , AUNI T S , D I ST FF , B Wl ND ( 4 ) 

3 ,WPRI0R(4)  ,APREP  rIPRD(3,14)  , NPD AT E , PRD AT E ( 14 ) 

INTEGER  HH,  TOPT,  AUM I TS , D I ST F F , B WI ND , WPR I OR , APR EP , PRO AT E 


DATA  BLOCK  FOR  CAS  CUMULATIVE  FILE 
CAS  DATA  SETS  14,  15,  16,  AND  17 
COMMON  /CASCUM/ 

1  CASCUM(32),  BUFFR(504) 

DIMENSION  ICASC(32),  DSET14(22),  DSET]5(22),  DSET16(22) 
1 ,OSET17(28) 

EUUIVALENCE  ( ICASC, CASCUM  ) 

equivalence  { DSET14,DSBT15,DSET16,DSET17,CASCUM(5)  ) 

1 , ( S0AERS,S0AERZ,S0AERK,S0AERC,CASCUM(24)  ) 

2 , ( SOPERStSOPERZ, SOPERRfSOPERC, CASCUM! 25 ) ) 

3 » ( S0VEKS,S0YERZ,SQYERR»SQYERC,CASCUM(26)  ) 


FLAGS  AMD  COUNTERS  FOR  CAS  SIMULATOR 
COMMON  /CASFLG/ 

1 H ,PPFLG  »MBW  ,IBW  ,uiMDOW,IPD 

2 ,NZTOr  ,NSTRAT,NYESSK,NSSHSK,NCAMSK,NRYES 

3 ,ENDC  ,ENDREG,ENnZON, IRSTR  , I RZON E , I RRE G 

4 ,LDS1  ,LQS4  ,LDS7  ,LDSB  ,LDS9  ,L0S10 

5 ,LDS14  ,LDS15  ,LDS16  , L DS 17 ’ , L RCOUN , L RRE G 
INTEGER  PPFLG  , WINDOW  , PPDATE 


,IPP  , PPDATE, MREGS 
,NRSSH  ,NRCAMS 

,LDS11  ,LOS12  ,LDS13 
,LRZONE,LRSTR 


CONTROL  PARAMETERS  FOR  LEM  PROGRAM 
COMMON  /CMTRL  / 


CAS3 

CAS3 

CAS3 

CAS3 

ARGLST 

ARGLST 

ARGLST 

ARGLST 

ARGLST 

ARGLST 

CASCM 

CASCM 

CASCM 

CASCM 

CASCM 

CASCM 

CASCM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CM  I'RL 

CNTRL 
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c 

c 


c 

c 


c 

c 


c 

c 


c 


1 PKIMTF,I\iSTART,SEED(7) 


INTEGER 

PRINTF 

DOUBLE 

PR6C I SION 

SEED 

CAS 

DATA  SET  7 

(AT  ZONE  LEVEL  ) 

COMMON 

/DSET7  / 

1  ZONE  »HWAZ2  , EZ  r M 1 K2KZ ♦ AN AL V Z t NSTR A Z , H W AZ 1 tEWAZl  ,HWAZ3 
2-  tESTVZ  »HWAZ12 

3 ,M1K2CL(10)  tEPWCL(lO)  tEPW2CL(lO)  tPKPICL(lO) 

4 ,PK2CL(10)  tPKCL (10)  ,SSQ(10) 

INTEGER  ZONE 

REAL  M1K2KZ,  M1K2CL 
DIMENSION  DSET7(8L) 

E(OUIVALENCE  ( DSET7,Z0NE  ) 


CAS  DATA  SET  8 (AT  REGION  LEVEL) 

COMMON  /DSETS  / 

1 REGION, HWAR2  , ER  ,M IK 2KR , AN ALVR , NZONE S ,H W AR 1 ,EWAR1  ,ESTVR 

2 ,M1M2ZR,FILL8(71 ) 

INTEGER  REGION 
REAL  M1K2KR 
DIMENSION  DSET8(10) 

EUUIVALEMCE  ( DSETH, REGION  ) 


CAS  DATA  SET  9 (AT  COUNTRY  LEVEL) 

COMM(JN  /DSET9  / 

1 C0UNTRtHWAC2  ,EC  , M 1 K2 KC , ANAL  V C , M 1M2ZC , HWAC 1 ,EWAC1  ,ESTVC 

INTEGER  COUNTR 
REAL  M1K2KC 
DIMENSION  nSET9(9) 

E(0UI  VALENCE  ( DSET9tC0UNTR  ) 


CAS  DATA  SET  11  (ZONE  DATA 
COMMON  /DSETll/ 

1 HWAZ  ,TWAZ  ,EWAZ  ,AERRZ 

2 ,TYZ  ,EYZ  ,YERRZ  ,M1Z 

3 ,ANPkVZ 
'■REAL  MIZ  , M2Z 

DIMENSION  DSETll (19) 
EQUIVALENCE  ( DSETll, HWAZ  ) 


I — FINAL  PASS) 

, AVARZ  ,TPRODZ, EPRODZ, PRERRZ, PRVARZ 
,M2Z  ,CT1Z  ,CT2Z  ,CT3Z  ,ANAVZ 


CNTRL 

CNTRL 

CNTRL 

CNTRL 

DS'ET7 

DSET7 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

.JULYT6 

JULY76 

DSET7 

DSET7 

DSET8 

DSET8 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

DSET8 

DSET8 

DSET9 

DSET9 

JULY76 

JULY76 

JULY76 

JULY76 

DSET9 

DSET9 

JULY76 

DSETll 

DSETll 

DSETll 

l^SETll 

DSETll 

DSETll 

DSETll 

DSETll 
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C CAS  DATA  SET  12  {REr7inN  DATA  — FINAL  PASS)  JULY76 

COMMON  /DSET12/  DStT12 

1 HWAK  ,TWAk  ,ewAR  ,AERRR  ,AVARR  » TPRODR,  E PR  ODR  , PRE  RRR  , PRV  ARR  DSE:Tl2 

2 tTYR  tEYR  ,YERKR  ,M1R  fM2R  »CT1R  »CT2R  ,CT3R  »ANAVR  DSET12 

3 tANPRVR  . DS'ET12 

REAL  MIR  , M2R  DSET12 

DIMENSION  nSET12{19)  DSET12 

, EQUIVALENCE  ( DSET12,HWAR  ) DSET12 

C . DSET12 

C CAS  DATA  SET  13  (COUNTRY  DATA  — FINAL  PASS)  JULY76 

COMMON  /DSET13/  . DSET13 

1 HWAC  ,TWAC  tEWAC  ,A6RRC  ,AVARC  , T PR  GDC , E PRODC , PRERRC » PR V ARC  DSET13 

2 tTYC  ,EYC  ,YERRC  ,M1C  tM2C  tCTlC  ,CT2C  tCT3C  ,ANAVC  l')SET13 

3 ,ANPKVC,CLEWA  , CLE PRD » CLATEC tCLPT EC , CL ATWC t CLPTWC  0SET13 

REAL  MIC  , M2C  ' 0SET13 

DIMENSION  DSET13(25)  . - DSET13 

EQUIVALENCE  ( DSET13,HWAC  ) ' DSET13 

D’SET13 

file  DEFINITIONS  AND  RECORD  LENGTHS  FILES 

COMMON  /FILES  / FILES 

1 SEGID  ,LSEGlDtCRnPW  t L CROPW , SUBHS T t L SUBH  , ACQUIS, LACO  FILES 

2 ,CAMSF  ,LCAMSF,CAMERR,LCAMER »CASF  ,LCASF  , Y ESOUT , LY ESO  FILES 

3 ,SIGEXT,LSIGEX» YESERRtLYESER, SEGTRU,LSEGTR,CASDIS,LCASD  FILES 

4 , INP  ,OUTP  ,TACO  ,LTACO  ,CASDSF ,LC ASDS  FILES 

INTEGER  SEGID  ,CROPW  , SUBHST  , ACQU  I 5.,  CAMSF  ,CAMERR,CASF  ,YESOUT  FILES 

1 tSIGEXr, YESERR,SEGTRU,CASDlSrOUTP  tTACO  ,CASDSF  FILES 

C FILES 

C INDEX  RECORD  FOR  CAS  CUMULATIVE  FILE  (CASE)  IXCASF 

COMMON  /IXCASF/  - IXCASF 

1 I XCASF ( 1 ) rLIXCAS  ' 

C IXCASF 

C INDEX  RECORD  FOR  CAS  INTERMEDIATE  DATA  SET  FILE  (CASDSF)  Ivr.nsF 

COMMON  /IXCDSF/  IXCDSF 

1 IXCDSF ( 1 ) ,LIXCOS  ‘ , 

C IXCDSF 

C LEM  CONTROL  CARO  INPUT  DATA  LEMCM 

COMMUN  /LEMCM  / LEMCM 

1 •TITLE(IO)  rICASE  ,CUNTRY  ,NTR I AL tR ST ART , I PR INT , ST ARTR , ST ART Z LEMCM 

2 ,ENDR  ,ENDZ  ,ISTG  ,ICAMS  ,IYES  ,IACQ  , I CL  ASS , I SE XT  ,ISCC  LEMCM 

3 ,ICAS2  ,ICAS3  , 1 PRC  AM  , I PRYE  S , I PRC’AS  , I C SESG  , I CSECW  , IC  SESH  , I’CSEC  E LEMCM 

4 , ICSEYM, ICSESE, ICSEAC,RSEED1, RSEED2,RSEED3,RSEEU4,RSEED5,RSEED6  LEMCM 
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5 ,RSEED7TlCSEST,ICSECat ICSEYS, ICSECUt ICSSCO  LEMCM 

DIMENSION  RSEED(7)  ’ ‘ LEHCM 

DOUBLE  PRECISION  RSEEO  V RSEED 1 » RSEE 02 , RSE ED3 » R S E ED4 , RS EE D5  LEMCM 

1 ,RSEEn<S  tRSEED7  ' . LEMCM 

■ EQUIVALENCE  ( KS^EO , RSEEO'l  ) ’ . LEMCM 

INTEGER  RSTART,STARTR,STARTZ,ENDR  »EN0Z  LEMCM 

LEHCM 

PAGE  EJECT  CONTROL  PARAMETERS  FOR  LEM  PAGECM 

. COMMLIN  /PAGECM/  . PAGECM 

I NPAGE  tNLINE  tMXLlNEtNSPTL  tSUBTTL(lO)  PAGECM 

PAGECM 

STATISTICAL  INFORMATION  FDR  LEM  STATS 

COMMON  /STATS  / STATS 

I ITER  tNSEGTR»NCAMSR,NYESR  »NREC 1 7 ) »NCASCR » NCASOR  STATS 

EQUIVALENCE  ('NTtITER  ) ‘ STATS 

STATS 

debugging  print  flag  CAS3 

COMMON  /DEBUGF/  DEBUGF  CAS3 

CAS3 

CAS3 

LOCAL  VARIABLES  CAS3 

I DO  LOOP  INDEX  CAS3 

IKEG  REGION  INDEX  ( 1 , 2 » . . - t NREG ) CAS3 

I ZONE  ZONE  INDEX  ( 1 t 2 , , . . » NZGNE S ) CAS3 

CAS3 

CAS3 

IF  ( M1K2KC  .EO.  0.0  ) GO  TO  990  ' JULY76 

CAS3 

INITIALIZE  REGION,  ZONE»  AND  STRATA  POINTERS  FOR  CAS  <•  CAS3 

INTERMEDIATE  FILE.  ( REGION  RECORDS  ARE  3-12,  ZONE  RECORDS  ARE  CAS3 
13-62,  STRATA  RECORDS  ARE  63-387  ) CASS 

110  IRREG=  2 

IRZONE=  12  CAS3 

IRSTR.  = 62  CAS3 

IREG=  0 . CAS 3 

CAS3 

INITIALIZE  DATA  SET  13  (COUNTRY  LEVEL)  . CAS3 

DO  130  I=1,LDS13  ■ ■ . CASS 

DSET13 ( I )=  b.O  • CAS3 

130  CONTINUE  CAS3 

C CAS3 
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C INITIALIZE  ' DATA  -SET  12  (REGION  LEVEL)  CAS3 

140  IKEG=  IREG  + 1 CAS3 

•DU  150  I=1,LDS12  ■ CAS3 

DSET12( I )=  0.0  CAS3 

150  CONTINUE  CAS3 

IZ0NE=  0 CAS3 

EM0REG=  0 ’ CAS3 

SET  MLINE  TO  CAUSE  PAGE  EJECT  BEFORE  PRINTING  NEXT  REGION  CAS3 

UN  AREA  AND  PROOUCTIt)N  SUMMARY  REPORT  ' CAS3 

NI.INE=  MXLINE  + 1 ‘ CAS3 

CAS3 

READ  DATA  SET  8 (REGION  LEVEL)  FROM  CAS  INTERMEDIATE  FILE  CAS3 

IKR6G=  IKKEG  + 1 CAS3 

CALL  RANACF  { CA SDS F , I RR EG , D SE T8 ,LC ASD S , I X CD S F , L I XCDS , I ) CAS3 

JULY76 

HWAR12=  HWAR2  J1JLY76 

JULY76 

IF  ( M1M2ZR  .ME.  0 ) GO  TO  180  JULY76 

M1M2ZR  = 0.  NO  ZONE  IN  REGION  HAS  AT  LEAST  2 ACQUIRED  SEGMENTS  JUI.Y76 
USE  ESTIMATED  GROUP  1,2  VARIANCE  AND  HISTORICAL  GROUP  1,2  JULY76 

wheat’ AREA  FROM  COUNTRY  LEVEL.  ' JULY76 

ESTVR  = ESTVC  JULY76 

AMALVR  = ANAL VC  JULY76 

HWAR12  = HWAC2  JULY76 

CASS 

INITIALIZE  DATA  SET  11  (ZONE  LEVEL)  CAS3 

180  IZUNE  = IZONE  + 1 CAS3 

IF  ( IZONE  .EO.  NZONES  ) ENDREG=  1 CAS3 

DO  190  I=1,LDS11  CAS3 

DSETIK I )=  0.0  - CAS3 

190  CONTINUE  CAS3 

• I ‘ c:as3 

read  DATA  SET  7 (ZONE  LEVEL)  FROM  CAS  INTERMEDIATE  FILE  CAS3 

IRZONE=  IRZONE  +1  ‘ CAS3 

CALL  RANACF  ( CAS DSF , I RZONE , DSET 7 , L C A SDS , I X CDS F , L I XCDS , 1 ) CAS3 

JULY76 

HWAZ12=  HWAZ2  ' JULY76 

'IF  ( MIK2KZ  .GT.  1 ) GO  TO  200  JULY76 

JULY76 

LESS  THAN  2 ACQUIRED  SEGMENTS  IN  ZONE.  USE  ESTIMATED  GROUP  1,2  JULY76 
VARIANCE  and  HISTORICAL  GROUP  1,2  WHEAT  AREA  FROM  REGION  OR  JULY76 
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C CUUNTKY  LEVEL.  JULY76 

ESTVZ  = ESTVR  JULY76 

ANALVZ  = a'mALVR  ' JULY76 

HWAZ12=  HWAR12  ■ ' JULY76 

IE  ( HWAR12  .EO.  0,0  ) GO,  TO  200  JULY76 

WRATIO  = ( HWAZ3/HWAR12  )>1‘*2  JULY76 

AVAKZ  = ESTVR-'WKATin  JULY76 

AMAVZ  = AMALVR5|«WRAT  in  JULY76 

CAS3 

COMPUTE  DATA  SET  10  FOR  EACH  STRATA  IN  THIS  ZONE  AND  AGGREGATE  CAS3 

INTO  data  SEt'‘i1  AT  THE  ZONE  LEVEL.  , . CAS3 

200  CALL  OSIO  v)ULY76 

IE  ( NFATAL  .NE.  0 ) GO  TO  990  CAS3 

CAS3 

GENERATE  REST  OF  DATA  SET  11  (ZONE  LEVEL)  CASS 

EQS.  I09t  113,  115'-  117  CAS3 

AEKKZ  = EWAZ  - TWAZ  CAS3 

PRERKZ=  EPROnZ  - TPRODZ  • CASS 

IF  { TWAZ  ,NE.  0.0  ) TYZ=  TPRODZ/TWAZ  CAS3 

IF  ( EWAZ  .NE.  0.0  ) EYZ=  EPRODZ/EWAZ  CASS 

IF  ( TYZ  ,NE.  0,0  ) YERRZ=  ( EYZ  - TYZ  )/TYZ  *100.0  CAS3 

CAS3 

CASS 

TEMPORARY  DEBUGGING  PRINTOUT  ' CASS 

CASS 

CASS 

AGGREGATE  ZONE  DATA  SET  II  UP  TO  DAtA  SET  12  (REGION  LEVEL)  CASS 

EOS.  125  “ 127,  129  - 131,  133,  137  - 143  CASS 

DU  440  1=1,7  CASS 

0SET12(I)=  DSET12(I)  + DSEriKI)  CASS 

440  DSET12( 1 + 12  )=  0SET12(I+12)  + nSETll(I  + 12)  • CASS 

PRVARR=  PRVARR  + PRVARZ  CASS 

CASS 

ON  FIRST  ITERATION  AND  FIRST  PREDICTION  POINT,  SKIP  READING  CASS 

CAS  CUMULATIVE  FILE.'  CASS 

IF  ( NT  .EO.  1 .AND.  IPP  .GO.  1 ) GO  TO  450  CASS 

CASS 

READ  DATA  SET  15  (ZONE  DATA)  FROM  CAS  CUMULATIVE  FILE  CASS 

MUTE  EQUIVALENCE  ( USE  T 1 5 , C ASCUM  ( 5 ) ) CASS 

CALL'  RWCASF  ( IRZONE ,CASCUM , 1 ) CASS 

C • ' CASS 
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C ACCUMULATE  ZONE  DATA  IN  DATA  SET  15  (CAS  CUMULATIVE  FILE)  C, 

IF  ( NT  ,GT.  L ) GO  TO  470  C- 

C FIRST  ITERATION.  CLEAR  DATA  SET  15  BEFORE  ACCUMULATING  C/ 

450  , ICASC( 1 )=  REGION  ' C/ 

ICASCC2)=  ZONE  . C, 

CASCUM{3)=  0.0  • Cl 

ICASC(4)=  NSTRAZ  C/ 

DU  460  I = 1tLDS15  ■ Ci 

DSET15 ( I )=  0.0  Cl 

460  CONTINUE  ’ Cl 

470  DO  480  1=1,19  C/ 

DSET15(I)=  DSET15(I)  + DSETIKI)  ■ Cl 

480  CONTINUE  • C/ 

C EOS.  173  - 175  , Cl 

SOAERZ=  SOAERZ  ■+  AERRZ'T*2  Ci 

SORERZ=  SOPERZ  + PRERRZ*«2  Cl 

SUYERZ=-  SOYERZ  + YERRZ-'l=2  Ci 

U 
Cl 

TEMPORARY  DEBUGGING  PRINTOUT  CJ 

Cl 
Cl 

WRITE  DATA  SET  15  (ZONE  DATA)  BACK  ONTO  CAS  CUMULATIVE  FILE  Cl 
'call  RWCASF  ( IRZONE.CASCUM, 2 ) ■ . Cl 

Cl 

UPDATE  ZONE  DATA  ON  CAS  D I STR IBUTION ' F ILE  Cl 

IF  { DISTFF  .NE.  0 ) CALL  RWOISF  {2,DSET11)  Ci 

C‘ 

PRINT  AREA  AND  PRODUCTION  SUMMARY  REPORT  DATA  FOR  THIS  ZONE  Cl 
IF  { PRINTF  .NE.  0 .AND,  APREP  .NE.  0 ) CALL  CASOUT  (-2)  Cl 

TEST  FOR  END  OF  REGION  C/ 

IF  ( I ZONE  .LT.  NZONES  ) GO  TO  180  ' Cl 

I C^ 

GEMERATF  REST  OF  DATA  SET  12  (REGl’ON  LEVEL)  Cl 

EOS.  128,  132,  134  - 136  Cl 

AERRR=  EWAR  - TWAR  • Cl 

PRERRK=  EPRODR  - TPRODK  • . Cl 

'■IF  { TWAR  ,NE.  0.0  ) TYR=  TPRODR/fWAR  Cl 

IF  ( EWAR  .NE.  0.0  ) EYR=  EPRODR/ENAR  Cl 

IF  { TYR  .NE.  0.0  ) YERRR=  ( EYR  - TYR  ) /TYR  ’nOO.O  Cl 

C ’ ' Cl 
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; . CAS3  ■ 

TEMPORARY  DEBUGGIMG  PR'INTOUT . CAS3 

■ ■ ^'AS3 

AGGREGATE  REGION  DATA  SET  l^'lTP  TO  DATA  SET  13  (COUNTRY  LEVEL)  CAS3 
EOS.  144  - 146,  148  -.1,50,  152,  156  - 162  CAS3 

00  540  1=1  ,7  CAS3 

DSET13(I)=  DSET1'3(I)  + DSET12(I)  CAS3 

540  DSET] 3( 1+12 )=  DSET13(I+12)  + nSGT12(I+12)  CAS3 

PKVARC=  PRVARC  + PRVARR  '•  CAS3 

CAS3 

ON  FIRST  ITERATION  AND  FIRST  PREDICTION  POINT,  SKIP  READING.  CAS3 
CAS  CUMULATIVE  FILE.  C.AS3 

IF  ( NT  .E(0.  1 .AMD.  IPP  . EO.  1 ) GO  TO  550  CAS3 

CAS3 

READ  DATA  SET  16  (REGION  DATA)  FROM  CAS  CU  MUL  AT  I VE-.  F I L E CAS3 

MUTE  ...  EQUIVALENCE  ( DS ET 16  , C A SCUM ( 5 ) ) CAS3 

CALL  RWCASF  ( I RREG  , CASCUM  , 1 ) C.AS3 

CAS3 

ACCUMULATE  REGION  DATA  IN  DATA  SET  16  (CAS  CU("1ULATIVE  FILE)  CAS3 
IF  ( NT  .GT.  1 ) GO  TO  570  . CAS3 

first  ITERATION.  CLEAR  DATA  SET  16  BEFORE  ACCUMULATING  CAS3 

550  ICASC(1)=  REGION  ' CAS3 

ICASC(2)=  0 ' . CAS3 

ICASC(3)=  0 . ■ ' CAS3 

ICASC(4)=  0 CAS3 

DO  560  I=1,lDS16  CAS3 

0SET16(I)=  0.0  CAS3 

560  CUNTINUE  GAS3 

CAS  3 

570  DO  580  1=1,19  CAS3 

DSET]6(I)=  DSET16(I)  + DSET12(I)  'CAS3 

580  CONTINUE  CAS3 

EOS.  176  - 178  . ■ CAS3 

S(OAERR=  SOAERR  + AERRR-^=i'2  CAS3 

S(.OPERK=  S(OPFRR  + PRERRR4^«2  CAS3  • 

SOYERR=  SOYERR  + YERRR-42'  CAS3 

CASS 

CAS3 

TEMPORARY  DEBUGGING ■ PRINTOUT  CAS3 

CAS3 

CAS3 
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C WHITE  data  set  16  (REGION  DATA)  BACK  ONTD  CAS  CUMULATIVE  FILE  CAS3 

CALL  RWCASF  ( I RREG , C ASCUH t 2 ) CAS3 

CAS3 

UPDATE  REGION  DATA  ON  CAS  DISTRIBUTION  FILE  CAS3 

IF  ( DISTFF  «NE.  0 ) CALL  RWDISF  (1,DSET12)  . CAS3 

CAS3 

PRINT  AREA  AMD  PRODUCTION  SUMMARY  REPORT  DATA  FOR  THIS  REGION  CAS3 
IF  ( PRINTF  .ME,  0 .AND.  APREP  tNE . 0 ) CALL  CASOUT  (-1)  CAS3 

TEST  FOR  END  OF  COUNTRY  . CAS3 

IF  ( I REG  .LT.  NREGS  ) GO  TO  140  CAS3 

CAS3 

GENERATE  REST  OF  DATA  SET  13  (COUNTRY  LEVEL)  CAS3 

EOS,  147t  151 » 153  - 155  CAS3 

AERRC=  EWAC  - TWAC  CAS3 

. PREKRC=  EPROnC  - TPRODC  ■ • CAS3 

IF  ( TWAC.. ME.  0.0  ) TYC=  TPRODC/TWAC  CAS3 

IF  ( EWAC  .NE.  0.0  ) EYC=  EPRODC/EWAC  CAS3 

IF  ( TYC  .ME.  0.0  ) YERRC=  ( EYC  - TYC  ) /TYC  *100.0  ,CAS3 

CAS3 

COMPUTE  CONFIDENCE  LEVELS  CAS3 

CALL  CONFL  CAS3 

CAS3 
CAS3 

TEMPORARY  DEBUGGING  PRINTOUT  ■ CAS3 

CAS3 
CAS3 

UN  FIRST  ITERATION  AND  FIRST  PREDICTION  POINT,  SKIP  READING  CAS3 
CAS  CUMULATIVE  FILE.  CAS3 

IF  ( NT  ,E0,  1 ,AND.  IPP  . EO,  1 ) GO  TO  650  CAS3 

CAS3 

READ  DATA  SET  17  (COUNTRY  DATA)  FROM  CAS  CUMULATIVE  FILE  CASS 

NOTE  ...  EQUIVALENCE  ( DSE T 17 , CASCUM ( 5 ) ) CASS 

, CALL  RWCASF  (2,DSET17,1)  ' CAS3 

CAS3 

ACCUMULATE  COUNTRY  DATA  IN  DATA  SET  17  (CAS  CUMULATIVE  FILE)  CAS3 
IF  ( NT  .GT.  1 ) GO  TO  670  . CAS3 

C FIRST  ITERATION,  CLEAR  DATA  SET  17  BEFORE  ACCUMULATING  CAS3 

650  *’DO  660  I=1,LDS17  CAS3 

DSET17 ( I )=  0.0  CAS3 

660  CONTINUE  CAS3 

C CASS 
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670  DU  680  1=1,19  CAS3 

DSeTl7(I)=  DS6T17(I)  + DSeT13U)  CAS3 

680  CUNTINUe  ‘ CAS3 

C EOS.  179  - 181  CAS3 

S0AEKC=  SOAERC  + AERRC>i=*2  CAS3 

S(0PERC=  SOPERC  + PRERRC--'=2  CAS3 

SOYERC=  SOYEKC  + YERRC*=<"2  CAS3 

\C  ACCUMULATE  CGNF I OEIMCE  LEVELS  ALSO.  CAS3 

DU  690  1=20,25  CAS3 

DS6T17(I+3)=  DSET17(I+3)  + DSET13(I)  CAS3 

690  CUNTINUE  CAS3 

C CAS3 

C CAS  3 

C TEMPORARY  DEBUGGING  PRINTOUT  CAS3 

C • ' CAS3 

C CAS3 

C ■ CAS3 

C WRITE  DATA  SET  17  (COUNTRY  DATA)  BACK  ONTO  CAS  CUMULATIVE  FILE  CAS3 

CALL  RWCASF  (2,DSET17,2)  ■ CAS3 

CAS3 

UPDATE  COUNTRY  DATA  ON  CAS  DISTRIBUTION  FILE  CAS3 

IF  { OISTFF  ,NE.  0 ) CALL  RWDIsF  (0,DSET13)  CAS3 

CAS3 

COMPUTE  MEAN  VALUES  AND  PRINT  AREA  AND  PRODUCTION  SUMMARY  REP0RTCAS3 
IF  { PRINTF  .NE.  0 ) CALL  CASOUT  (0)  CAS3 

CAS3 

CLOSE  CAS  INTERMEDIATE  FILE  CAS3 

CAS3 

ON  THE  FINAL  ITERATION  (UNLESS  NTRIAL  = 1),  COMPUTE  CAS3 

CLWA  AMD  CLPRD  IN  DATA  SET  18.  CAS3 

IF  ( NT  .E(0,  NTRIAL  .AND.  NT  .GT,  1 ) CALL  DS18  CAS3 

C s'  • C'VRB 

990  RETURN  CAS3 

C . ' CAS3 

C ' CAS3 

END  CAS3 
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ooooto 
oooo  I'j 
000016 

0000  1 7 
000018 

00001  9 
000020 
0000?! 
ouuo?2 
o'ono?3 
0000?'! 
0000?b 
000026 
000027 
000028 
000020 
000030 
000031 
000032 
000033 
OOny-^O 
0 00'0  35 
000036 
000037 
000038 
000039 
0 0 0 0 « 0 
OOOOOl 
000002 
000003 
ouoooo 
oooo Ob 
000006 
000007 
000008 
000009 

oono^'.o 

OOOObl 
00O()'>2 
0 000b  4 
000090 

oiioobb 

000096 

OOOOH7 

n«oo'>8 


S'lbWOUTlNF  CLASSCSEEDPf TYPEfWINOOWfHtBCCfSinCCfXn  . Ct  A.3S 

c ■ class 

C THIS  SUBROUTIMf;  CAI.CUI  AThS  THE  INPUT  CLASSIFICATION  tRROR  FOR  Cl  ASS 

C • TRAIlJING  SeOHFNTSt  -ANP  THF  TOTAL  CLASSIFICATION  tRROH,  Ct  ASS 

C Cl  ASS 

COMHON/CAMERR/  C0UN2 » 1 HfG2 t I 70nE2 t 1ST R A2 » I SU02 f I 5F G2 f CANFRR 

1 HW(3,0),(3fRR(3,0j  ,ST0rRR(3,0)  CAdlRR 

COHHOM/THAIMS/  C0UN7 , I R t 07 » I Z0Nt7 » IS  T R A 7 , 1 SUI3  7 » I St  C.  / . II-'AThS 

• 1 IIWiM(0,2S),  nT0T,TNNl3,0,2b)  »rufU3f  0,?b)  ,TVV('3»0t2b)  * TRAINS 

1 Tt'TRiJt  IZllLU(O)  ,T(>tSl(O)TlPfRR(0)  , I FR I OH  3 J f I M ( 3)  , T V ( 33 » T B ( 5)  TRAINS 
INIFOIR  ruULU  n-’AINS 

DIHFNSlON  1TRAIN(I29)  TRAINS 

EPUl VALtNCeC IlKA IN,CU0N7)  IF  AT  NS 

C rOMlROI  PaRAMLTIiRS  FnH  LEM  PROGRAM  CN1RL 

common  /CN.TrI,  / CNT9L 

1 PM-nTF  ,IJSIAi;T,SLFL)(  71  ■ CNfRc 

INIMjFr  PRIuTt  CMTk’L 

OOUfILt  PRFCtSlON  SFfcP  CNTRL 

C CNIRL 

C CAMS  CONTROL  LAHT)  INPUT  DATA  CAHSC-H 

COMMON/CAMSCM/  IMOpFL . I MUl. T I » I S I GFX  » I SK  IP f I T H AX t IRfcP  j IW  INDf  CAmSc‘m 

I IGl<UUP(3f2»lb3  iriS(3,2t3)tC>Ut2»23  »M(3t2*2)  CAMScM 

real  Ms  ‘ , CAtiScH 

C . CAllScH 

COHI10N/M<ROR/TITL(01  f iDATEf  PtSriMfTOTtALOCAl  tFRTOH3  3 tRROR 

1 ttP|irAS(33fLRHANP<33,CLTOHi),CLBlASf3)trLRANOr3)fDLLTAf  • ERROR 

1 CRUP(i«  7{  3t?3  tl.ULH3)  »TTDHRAINAi  TKAIMU  ERROR 

D I HENS  I ON  lERSCOiO  ERROR 

ENUTVAl FNcEClITLt IER3)  ERROR 

RF  Al  Mul  I ERROR 

• iMirutR  no.cRoPO  tt?ROR 

C ■ ARt.tjM.LHT  LIST  FOR  FRROR  PROCESSING  AR(.[  ST 

COMMON  /AROLSl/  ARl.lST 

I MERrS  jNFaTaI  fNPFRT^SfNARG  fARGClOl  ARUI  ST 

0 IMF  NS  I ON  IARG(IO)  ARUIST 

EOUl valence  ( TARGfARG  ) . ARClST 

C ' ' ARGl  ST 

INTFCFr  lYPEt  rilNOOW  . C!  ASS 

REAL  H , Cl  ASS 

OnUHLT  PRECISION  SEFD?  . CLASS 

C ■ CI'ASS 

C ADO  INPUT  CT ASSIFTCATIUN  FRROR  TO  CROP  CALENDAR  ERROR  Cl  ASS 

()  = l)rRR{TYPE,nlNDO.n  + HCC  Cl  ASS  ' 

SIU=&NRHSIGf  RfUTYPE*WlNDDw)»5ir,ERR(TYPCtWlNDOrt3+5IOCC»SlCCC)  Cl  ASS  ‘ 

C CLASS 

C COMPUTE  xbAP  and  SiOMAt  THF.N  XI  • . Cl  ASS 

XHAR=PwnYf’F,WINUOW)HI.  +M  +8)  Cl  ASS 

SIGMArv'WnVPl  tHlNPOW)  ♦m?SIC  U ASS 

CALL  IFIAO  fSFH)2»XBARtSK.«AtXI»0«lFR)  ‘ ‘ Cl  ASS 

NAUC.=  | . LI  ASS 

IARr,(1)  = IFR  Cl  ASS 

IE  (Tt  P.CI  .0)  Call  tRRMEG('NlCAHSfbHCLASS.<JrO)  U ASS 

lF(HR.(>b,3)  XI  = XbAR  : Cl  ASS 

C , Cl  ASS 

C.  ERROR  RFpORT  ■ Cl  ASS 

10  CONTI NUF  Cl  ASS 

IF-(Pl(lNTF.l.r,0,OR.lRtP.I  £,0)Rr  TURN  Cl  ASS 

IVnifPF)=().  ' ■ Cl  ASS 
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OOOOS9 

000060 

000061 

000062 

000063 

000064 

00006‘j 

000066 

000067 

000066 

00006<J 


1F(SIGhA,F«.0.?  go  to  1? 

TVdrPf  ) = (XI-XBAH)/(FWC7YPE»HIND0W)*M) 
12  CO.'/TIHuF 
. Cl.!(TA?(7YPh)=15 

CU<ANO(TYPf)  = TV(TYPn 
Cl  ini  ( rYPf  )=1}  + TV(TYPL) 
emoi  (TYpn=M*(fi+Tv(rYPF))  ' 
ERblAScTYPL)sMll3 
ERKANn<1YPL)=M+TVCTYPF>  ' 

RETURN 

fcUD 


Cl  ASS 
C!  ASS 
Cl  ASS 
Cl  ASS 
C!  ASS 
tt  ASS 
Cl  ASS 
Cl  ASS 
U ASS 
Cl  ASS 
Cl  ASS 
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FUR, IS  CL  ASSN 

SUBROUTINE  CLASSN 

C THIS  ROUTINE  CONTROLS  THE  COMPUTATION  OF  CLASS  NUMBERS  AND 

C GENERATION  OF  ISUBH2  FILE  FROM  THE  SUBHST  FILE. 

COMMON/ FILESl/ 

1 ISURH2 ,LSUBH2 ,MXCLSS 

c Flags  and  counters  for  cas  simulator 

. C(JMMUN  /CASFLG/ 


THE 


c 

c 


c 

c 


1 H tPPFLG  ,NBW  ,IBW  . , WINDOW, IPD 

2 ,N/.TOT  ,NSTRAT,MYESSK,NSSHSK,NCAMSK,NRY£S 

3 tRNDC  ,ENDREG,ENDZ0N, IRSTR  , IRZONE, IRREG 

4 ,LDS1  ,LDS4  ,LDS7  ,LDS8  ,LDS9  ,LDS10 

5 ,LDS]4  ,LDS15  ,LDS16  ,LOS17  , L RCOUN , L RRE G 

INTEGER  PPFLG  , WINDOW  , PPDATE 

CONSTANT  OUAMTITIES  FOR  LEM  PROGRAM 
COMMON  /CONST  / 

1 NTRMX  ,MAXR  ,MAXZ  , I MX SEG , ENDF IL , I T SFG 


,IPP  , PPDATE, 
,NRSSH  ,MRCAMS 

,LDS1L  ,L0S12  T 
,LRZt)NE,LR5TR 


NREGS 

LDS13 


LEM  CONTROL 
COMMON  /LEMCM 


CARD  INPUT  DATA 
/ 

X TITLE(IO)  ,ICASE  , CUNT RY , NT R I AL , R ST  ART , I PR  I NT , ST ARTR , ST  ART Z 

2 ,ENDR  ,EMDZ  ,ISTG  ,ICAMS  ,IYES  ,IACO  , I CL A S S , I SE XT  ,ISCC 

3 , 1CAS2  ,ICAS3  , I PRC  AM  , I PR  YE-S  , I P RC  AS  , I C S E SG  , I CSECW  , IC  SESH  , I C SEGE 

4 , ICSEYM, ICSESE,ICSEAC,RSEED1, RSEED2,RSEED3,RSEE04,RSEED5,RSEED6 

5 , RSEEQ7, ICSeST, ICSECO, ICSEYS , ICSECU , IC SECD 
DIMENSION  RSEED{7) 

DOUBLE  PRECISION  RSEED  , RS  E E'D  1 , RSE  ED2  , RS  EED  3 , RS  EED4  , R SEE  D5 
1 ,RSEED6,KSEED7 
EQUIVALENCE  ( KSEEDtRSEEDl  ) 

INTEGER  RSTART, STARTR,STARTZ,ENDR  , ENOZ 

INDEX  RECORD  FOR  INTERMEDIATE  SUBSTRATA  HISTORICAL  DATA  FILE 
COMMON  /IXSUBH/ 

1  L IXSSH, IXSUBH (1 > 

file  DEFINITIONS  AMD  RECORD  LENGTHS 
COMMON  /files  / 

1 SEGID  ,LSEGIO,CROPW  , LCROPW , SUBHS T , L SUBH  ,ACOUlS,LACO 

2 ,CAMSF  ,I.CAMSF,CAMERR,LCAMER,CASF  ,LCASF  , Y ESOUT  , LY  ESO 

3 , S1GEXT,LS1GEX ,YESERR,LYESER, SEGTRU , L SEGTR , C ASD I S , L CA SO 


'l>  'I**  '<•*  v 

5|s  }}:  s|i 

FILESl 

FILESl 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CONST 

CONST 

CONST 

CONST 

LEMCM 

LEMCM 

LEMCM 

LFMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

IXSUBH 

IXSUBH 

MODI 

IXSUBH 

FILES 

files 

FILES 

FILES 

files 
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4 tiNP  »01JTP  ,TACO  ,LTACO  , CASDSF , I.CASDS  FILES 

INTEGER  SEGID  »CRGPW  , SURH  ST  t ACOlJ  I S t C AMS  F rCAMERRrCASF  ,YESOUT  FILES 
1 , SIGEXT,YESFRR, SEGTRUtCASDISrOUTP  ,TACO  , CASDSF  FILES 

C FILES 

C CAS  DATA  SETS  lt2»  AND  3 DSETl 

CUMMGM  /DSETL  / ' . USETl 

1 ISUBSTtTWAK  ^HWAK  ,EWAK  ,M1K  ,CT1K  ,ANAI.VK,EPWK  tEPW2K  JULY76 

2 , SMPKP I ,SUMPK2 ,SUMPK  ^KSUB  ,NCLASS  JULY76 

REAL  MIK  , M2K  JUI.Y76 

, DIMENSION  DSETK14),  DSET2(14),  DSET3(6)  JULY76 

EQUIVALENCE  ( DSETl , DSET2 , DSET3 , I SUBST  ) , DSETl 

L , ( M2K,M1K  ),  t CT2K  ,CT3Kf  CTIK  ) ..  . DSETl 

C , . DSETl 

C ARGUMENT  LIST  FOR  ERROR  PROCESSING  ARGLST 

CUMMUN  /ARGLST/  ARGLST 

1 NERRS  ,NFATALtNPEKRS,NARG  »ARG(10)  ■ ARGLST 

DIMENSION  lARGllOl  ' . ARGLST 

EQUIVALENCE  ( IARGtARG  ) ■ ARGLST 

C ARGLST 

C TABLES  MECCESSARY  TO  DETERMINE  CLASS  SETS  WITHIN  A ZONE  CLSTAB 

COMMON  /CLSTAB/  CLSTAB 

1 ■ ISTRATI  300  ) ♦ I S6STR(  300  ) » MSCNT(  300  ) , IGROIJP  ( 300  ) , I DATl  ( 300  ) , MODI 


2 IDAT2 { 300 ) ,XORD{300 ) , IXPT ( 3 00)  , I RANK ( 30 0 ) » I BP T ( 10 ) , I E PT ( 1 0 ) tMODl 

3.  MAXCLS  » ICLCNT,  ISUBL,MACO 

DIMENSION  DAT1{300),DAT2(300) , RANK (300) 

EDU I VALENCE  ( IDATl ( 1 ) ,DAT1 ( 1 ) ) , ( IDAT2( 1 ) , DAT2( 1 ) ) , ( I RANK ( 1 ) , 

1RANK(  1 ) ) ' 

C SUBSTRATA  HISTORICAL  DATA  FROM  SUBHST  -EILE 

COMMON  /SSHDTA/ 

1 C0UN2  ,IREG2  ,IZ0NE2,ISTRA2,ISUBS2tNSEG  ,IDSEG  ,GRPN0  ,H 

2 tAKEAK  ,PWK  ,NAGR  ,NA  ,DELTPW,DELTPM,CV1  ,CV2  ,C 

3 ,CV4  tVMULTK  , CLASS  ( 18  ) ,MX|K  ,RDSSH 
INTEGER  GRPNO  » CLASS  t RDSs'h 
DIMENSION  SSHDTA(39) 

EQUIVALENCE  •(  SSHDTA,  C0UN2  ) 

C 

DIMENSION  IBUF(39) 

''DIMENSION  BUF(39) 

equivalence'  (8UF  ( ) ) , I BUF  ( 1 ) ) 

DIMENSION  IDUM(150) 
data  MAXSCT/300/ , IRCT/19/ 


CLSTAB 
MODI 
CLSTAB 
CLSTAB 
SSHDTA 
SSHDTA 
ISTPW  SSHDTA 
V3  SSHDTA 
JULY76 
JULY76 
JULY76 
SSHDTA 
• SSHDTA 

^4'  <'1^ 

MODI 

MODI 

MODI 
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ISUR  = 1 
NDRD  = 0 
DO  5 1 = 1739 
IBUF( I ) = 0 
SSH[)TA(  I ) = 0.0 
5 CUNTIMUE 
IFIRST  = 1 

IF{  IPP  .iME.  1 >0,0  TO  15 
MAXCLS  = 9 

CALL  RANACF{  I SUBH2 t 0 , 0 , 0 t I X SU BH 7 L I X SSH , 0 ) 

15  ISUBl  = 0 
NACO  = 0 

DU  20  I=1,MAXSCT 
I STRATI  I ) = 0 
ISBSTKI  I ) = 0 
NSCNTI  I ) = 0 
IGKUUP ( I ) = 0 
IDATK  I ) = 0 
IDAT2 { 1 ) = 0 
20  CUNTINUE 

22  IF(MC)RI)  ,E(0.  0}GD  to  25 
NDRD  = 0 

IF( IPP  .EO.  1 )G0  Tn  30 
- GO  TU  45 

2 5 IF(  IPP  .fvlE.  1 )Gfl  TO  40 

READ(SIJBHST)  ( IBl  IF  ( I ) 7 I = 1 , 6 ) t ( IDUMl  J)  7 J = 1.7  IMXSEG)  7 ( I BUF  (K  ) 7K=8,L9) 

BUF(19)  = 1.2 

IF(  IFIRST  .EO,  0)G0  TO  27 

IFIRST  = 0 

GO  TO  30 

27  IF(IBUF(2)  .NE.  IREG2  .OR.  IBUF(3)  .NE.  IZ0NE2)G0  TO  80 
30  DO  35  1 = 1 7 IRCT 

SSHOT A ( I ) = BUF ( I ) 

3 5 CUNTINUE 

GO  TU  54 

40  CALL  RANACFI  ISUBH27ISUB7IOUF  7LSUB  H2,,  I X S U8H  , L I X SSH  7 1 ) 

IF{ IFIRST  .EO.  0)GO  TO  42 

IFIRST  = 0 . ■ ’ 

GU  TU  45 

42  IF(IBUF(2)-  .NE.  IREG2  .OR.  IBUF(3)  .NE.  IZ0NE2}G0  TO  80 
45  DU  50  1=1 7 IRCT 


^1% 

iji  s;«  3;cs;«  j;s  Si's 
s;s;;c3;s;;«5;cs’!>;e 

■J*  .t,  .U  «i> 

-r  ^1'  'I'  '1^  •'I' 

;.•£  s;<  j;s  5|;  >S:  j;s 

7,1.  wl. 

^1%  »(> 

«).  7,1.  .1# 

-J-  y,% 

*V»  V<» 

•»('* 

SjC  >,<  5,i  5,7  ?JC 

?|X  3|C  9|C  $i« 

vi.' 

•.!> 

^1%  ^|V  ^1% 

\ly  sO 

.■j'.  ^,V  ■.J.  #1^ 

.1^  v»«. 

gf,  ,f.  .,.  .|. 

.1^  H*.  *•<.  *'•'  7L 

J|V  .4.  ^4^  ^l". 

.V 

;|5  >J;  ;|:  >|«  3|s  >[<■ 

k*. 

^1%  ^4^  .4^  #1*.  .|% 

1-.*^  .1.  .A* 

.jV  .4.  ^|S 

.1.  7.1^ 

•'I*  '»*  *T  "r 

.1^  7.1^  s'y  sl> 

*4-  .|7  .4>  ^7  ..,7  .|7 

7!^  7l<i>  s'*  .•*  s'* 

*1^  *47  «»47  *4.  *|7  *4>  *47 

>;« 


•ff  .■*  7>*  s'*  s'*  s'*  s'* 
?|S  *jS  /|S  *47  *47  *47  *|7 

4C  *|S  «{s  *jC  *|\  ^S 


s'*  s'*  s'*  s'*  s'*  si* 
*4%  *|S  *|S  *47  *|S  *47 


NODI 


MODI 


s'*  s'*  s'*  *'»  si*  si*  s'* 
*,S  *|S  *|S  *4S  *jS  *47  *|S 

s'*  s'*  s'*  7'*  s'*  si*  si* 

*|S  *4«l  4«  *47  *|S  *|7  *|7 

s',  s'*  s'*  7'*  s'*  s'*  s'. 
*,S  5,7  *47  *^  *,7  *47  *,S 

s'*  s'*  s'*  si*  s'*  s'*  s'* 

*,,  *,7  *47  *,7  *4S  *47  *,s 
si*  7>*  s<*  s'*  si*  s'*  s'* 
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SSHOTA  ( I ) = BIJF  ( I ) 

50  CLINTINUE 

54  mIK  = 0 

IF{MSEG  ,NE.  0)CALL  GROUP 
MXK  = MIK 

55  ISUB  = ISU8  + L 
ISUBl  = ISUBl  + 1 

1F(  ISUBl  iGT.  MAXSCDGG  TO  200 
ISTRAT ( ISUBl  ) = ISTRA2 
ISBSTR( ISURl ) = ISUBS2 
NSCNT( ISUBl)  = MXK 
IGKOUP( ISUBl ) = GRPMO 
0AT3 ( ISUBl ) = AR6AK 
DAT2( ISUBl)  = HISTPU/100.0 
ISMl  = ISUB  - 1 

1F(IPP  ,EQ.  DCALL  R AN  AC  F ( I SU  BH2 , I SM 1 , SSH  DT  A t LSU  BH2  , I X SUBH  , L I XSSH  » 
12  ) 

GO  TO  22 

80  nurd  =’  1 

NACO  = 0 

DO  85  I=lfISU81 

NACCO  = NACO  + NSCNT  ( I ) 

85  CONTINUE 

IF(NACO  .GT.  MAXSCT)GO  TO  200 
IFINACU  .LT.  2)G0  TO  90 
IF(NACO  .LT.  2*H)G0  TO  95 
GO  TO  100 
90  CALL  ASSCLS(l) 

GO  TO  105 
95  CALL  ASSCLS(2) 

GO  TO  105 
100  CALL  SEGTAR 
CALL  DETCLS 
CALL  ASSCLS(O) 

105  1 = ISUB  - ISUBl 

DO  110  J=l, ISUBl 

CALL  RANACF ( I SUBH2 , I ♦ SSHDT A , L SU BH2 , I XSUBH , L I X S SH , 1 ) 

CLASS!  IPP  ) = IDAT2  U ) 

• CALL  RANACF ( ISUBH2, I , SSHOTA ,L SUBH2 , I XSUBH , L I X S SH , 2 ) 

1=1  + 1 


MODI 

?jc 

MOD] 

MODI 

MODI 

.4^  vl. 

^1% 

,f.  3^.. 

>1. 

|«  ^1% 

1.1^  <.1^  .V  «•> 

I'lS 

i[<  >;<  ?;s  >|<  >;«  >;«  5{: 
5jS  5|<  ?JC  5jC  5|{  i\i  3}S 

.'l'. 

»•.  ^1^  ..V  sL  «'» 
''l'  *’»'*  "t"  't'-  ^1*  'I' 

S'C  jjc  5*>  »*» 

sjc  >\i  ?jc  sjc  ^ 

O. 

^1% 

.,■4  %!..  s’.,  si. 

^|S  .|S  >|S  ^s 

S*.  S^.  si.  si.  s’,  s’,  s’. 

.,s  .,s  .,s  .,s  .,1; 

s’,  s’,  si.  s’,  s’,  s',  s’. 
.,s  .,s  ,f.  .,S  .,S  J,S  .,s 

s',  s'.  sU  s',  si.  S^  %l. 

s’,  s’,  si.  s*.  '*.  s’. 

^S  .*>s  .fS  .|«  .<s 

;;s  :;t  >;t  3\i  sis  5}:  sis 

s>.  s>.  si.  si.  s',  s',  si. 
.|S  ;i||s  .|S  .|S  .|S  ^s 

s’,  s',  s’,  s’,  s',  s*.  s’. 

.|S  ^S  .|S  .|S  .|S  .|S  .^s 

si.  si.  si.  si.  si.  s«.  si. 
.JS  .jS  .|S  .|S  .|S  ^S 

s|*  3|S  3|S  3]s  3|S  3|S  3^4 

s',  si.  si.  si.  si.  si.  si. 

.fS  |.|S  .|S  .^S  .^S  .|S 

sis  sis  sis  sis  sis  sis  sis 
sis  sis  sis  5ls  sis  sis  >ls 

s’,  si.  s’,  vl.  si.  •>*. 

.(S  <rf  \ .*»  »(<  .4*  .(» 

3^  3|S  3,k  .jN 

51.  s’,  si.  s',  si.  si.  si. 
|S  .|S  .jS  .4S  .4S  .|S 

s’,  si.  si.  si.  s',  si.  si. 
i>|S  .|S  .|S  .^S  .|S  •>|S  .|S 

s',  si.  si.  s',  s’,  s',  si. 
.,s  .,s  .js  .js  .,s  ^ 

si.  «sl.  V.  si.  s',  s’,  s’. 

TS  -,s  .,s  .JS  .,s  .,s  .,S 

y.  *'J  3^s  5*s  3*s  5*C 

si.  s',  si.  si.  *«l.  si. 

.|S  .|S  .|S  .4S  ^S  .jS  .|S 

s’.  S*.  S*.  S*.  si.  s’,  s’. 
.,S  .|S  .fS  .|S  .|S  .|S  .|S 


110  CONTINUE 
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IF(BUF(1)  .EtO.  ENDFiDGn  TO  150 
IF(ENPK  .EO.  0)G0  TO  15 
IF(IBUF(2)  - ENDk)15tll5tl45 
115  IF(EMDZ  ,E0.  0)Gn  TO  15 

IFdHUFO)  .LE^  EN0Z)G0  TO  15 
1^15  BUF(l)  = ENDFIL 
150  IFdPF  .NE.  DGD  TO  152 

CALL  RANACF(  I SUBH2 , I SUB r I BUF , LSUBH2 1 1 XSUBH »LI XSSH , 2 ) 

152  HE  WIND  CAMSF 

DU  155  UltNCAMSK 
, KEAD( CAMSF ) 

155'CUNTIMUE 

NKCAMS  = MCAMSK  - 1 
GO  TO  210 

200  NFATAL  = MFATAL  + 1 

WKITE(OUTP.»900>  IREG2,IZOME2 
210  IF (MFATAL  .EO.  0 ) GO  TO.  250 
WRITE (QUTP ,901  ) 

STOP 

250  RETURN 

900  FORMAT ( 1H0,48HEITHER  TOO  MANY  SUBSTRATA  OK  SEGMENTS  IN  REGION-, 
16H  ZONE-, 1 A) 

901  FORMATdH  ,43HFATAL  ERRORS  IN  PA'SS  0 OF  CAS.  RUN  ABORTED.) 

END 


MODI 

^ 

sU 

'i'  •'1^  'f'  '4' 

%•# 

'I'  'I'  '4*  '4*  'll'  '1^  '4* 

.1.  «,4.  ^1.  kI.  .V 

'p  ■»js  »'j» 

MOD  1 
MODI 


MODI 

.O  ^4^ 

'I'  'I'  ■Av  n'  'r  'I'  '4' 

«4/  x4^ 

'4*  •>'  '4**  *>'  'I'  'I' 

>\s  5js  5^?  2|w|( 

-tV  sl^  V' 

#|S  .<1^  rjx 

.4.  .,1..  .1.  v1.  ,^1. 

'I'  'I'  'll'  '4**'4» 

>1?  O’  '4'  'i'  'I'  n* 


'I'  '5^  '4» '4' ^ 

sl^  %4, 

,>1^ 

14, MODI 
MODI 

^|S  ^|S  ^|S 

'|C  ^|C  '|C  )|C 
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Li  CONKt r 1 t760027f 


39077 


1 


C 

c 

c 


c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 


c 

c 


c 

' c 


c 

c 


1 


c 

c 


SUPrOUTINO  lonfl  confl 

COMPUTFS  CONriDFNcE  LEVELS  TN  OOTA  SET  13  CPNFL 

■ CONFL 

AHr-UMtNT  list  for  fRROR  PH0CF5S1MG  AIUU  ST 

COHMOM  /AKfJLST/  ARGLST 

1 MCRinS  jNFaTM  ,NPKKRS,NAftG  fARG(lO)  . AR(;(  ST 

DINf-NSinN  lAttCnOJ  AK'GIST 

FOUIVAlINCE  ClARCfAHG  ) • Ai-GI  ST 

Ai>Gl  ST 

CA3  DATA  SFr  15  fCnUMTHY  DATA  — SI COND  PASS)  OSt 1 I 5 

COlP-lOA'  /P5FT13/  DSLT13 

) HWftc  ,1HAC  fF«AC  -,AFRRC  tAVAKC  t TPROCC ♦ F PPOtlC ? PRERKC tPKV ARC  0Siri5 

2 ,tTY(  ♦LYC  lYtRRC  »M1C  ♦H2C  tCUC  »C12C  tCT3C  lANAVC  l).stTl3 

3 f ANPrVCiCI  EWA  rCLFPHOiCLATECTCLPTFCtCLAThCrCLPTWC  0SHj3 

RFAI  HtC  r.  h2C  DSF  T I 5 

DIHFtiSlON  nsF;i)3(2S)  l)StT|5 

tOUTVAtF'Nrt  ( OSFIlitHWAC  ) OStTlS 

U.Sfc  T 1 5 

LOCAL  VAKIAIIUF.S  CPllFL 

X = aRGUMFNT  fop  P(X)  FUNCTIO''!  ClUiFL 

XI  = ARCUIiFKT  for  P(X)  function  CONFL 

X2  = argument  for  PCX)  FUNCnUN  CONFL 

Y * = vAKiANCF  nUANTlTY  USED  Tj  CALCULATE  X*  Xlf  OR  X2  COnFl 

conf'l 

CONFL 

rOMpUIF  CLF.WA  (to,  165)  CIINFI 

APGCDs  SHAVaHC  CMNFL 

lARf.  (?)=  Hi  5 CONF'L 

Y=  VS('B(AVANC*LWAC)  CONFL 

X=  O.UFWAC7Y  CONFl 

cllwa=  ( 2,o»Psim(x)  - 1,0  )»ioo.o  confi. 

.•  CONFL 

ruNpUTF  ClATF'C  CFO.  166)  CONFL 

XU  ( FWAC  - 0.9  + TNAC  ) /Y  CONFL 

X2s  C fcWAC  - t.MTNAC  )/y  • CONFL 

Ct  ATtr=  ( psuncxn  - (>,SltBCX2)  )*100,0  CONFL 

CONFL 

COHpUIF  CLFPRI)  CFO,  165)  CONFL 

ARCfl)=  OUU'HOC.r  _ CONFL 

IARt;(2)=  16'!  , LliNFL 

Y=  YSUb(PRVARC,FPROOC)  • CONFL 

0 * I *r Pi?of*c / y c^NFi, 

CltI’Un=  ( 2,0*PSUt)(X)  - i.o  )*100.0  CONFL 

CONFL 

rOMpUIF  CLPTFC  CFU.  167)  COnFL 

XU  c iPRoiir  - n.o^TPiuinc  )/Y  . confl 

X?=  C tPKOpC  - I.UTPpudC  )/Y  CORFU 

clptefs  c psuBcxn  - pstmcxa)  )*ioo,o  confl 

CONFL 

COl'pUTF  CLATNC  CEO,  168)  CONFL 

ARGCn=  bHANAVC  CONFI, 

IARGCPjs  168  COWFL 

Y=  YSrioCANAVCt  IHAC)  ‘ ‘ CUNFl 

XU  c FWAf  - 0.9+TNAC  )/Y  , CONFL 

X2s  ( ( KAC  - I.UIkAC  )/Y  ' UiNf'L 

Cl.ATHr=:  C PSIiPCXl)  - PSNL1CX2)  )«100.0  Cr.NF'L 

CON!  I 

ruHpUlF  C|P|WC  (F,n.  169)  CONFL 
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0000S9 

' ARG(1)=  6HAM('ftVC 

oooo<.o 

IAI-in(5)=  J69 

QOOO*  1 

Y6U|j(ANPRVCtTFR(J0C) 

• 

000065  . 

Xl=  ( f-PHOOC  - O.OtTPPOPC 

)/Y 

000u6i 

X5=  c fprouc  - l,l»TPf?UnC 

)/V 

000064 

CIPTnr=  ( HSl-15(Xn  - PSI)b(X2) 

000O6S 

C 

000066 

900  RFTtIHN 

000067 

two 

tf'NFL  ‘ 

CnNFL 

Ct'NFL 

CUNFL 

tONfL 

criNFL 

CC'NFL 

CntJFL 

confl 
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0 FU 


r0RRFL*l»7(>0'l27t  ' f 1 


000001 

SUUROUtINF  CClRRrLClTHAX,AC«NO»HTNtMJW,IUSt) 

oonoo^ 

C 

000003 

c 

THIS  SIJRROUTINE  TRIPS  To  CORRELATE  A TRAINING  SFGHENI  WITH  THE 

oonoo'i 

c 

OROINaRV  SEI.NfNt  I3FING  RROCESSFDt  USING  TKF  PRIORITY  LIST, 

ooooos 

c 

000006 

COMHOM/SfcGTRU/COIJN4,IRfcn4f I2UNE4,16THA0tISU84tIS£G4, 

000007 

1 Ilf  lf’RHJR(6),lSPW>Pr(2) 

OOflOOO 

COMMON/TRAINii/  COUN/,IpfcG7,I/0Nfc7.  I ST  HA  7 , 1 SUD  V f 1 SEG7  » 

oooooR 

• 

1 . T 11  Il!(4,^‘jl  f I rTUT,TI1M(  3,4t?3)fTli1}(  3|4,R3I  . T V V ( 3 j 4 , ?b ) » 

OOOOIO 

1 TI'TrUI  , I T/:iiLn(4)  , )i>bsT(4)  ,THbRR(4)  ^TMOOUi)  tlH<3)  ,TVC3)»TR(5) 

000011 

INTFGFH  IJZULU 

OOOO  1<I 

DTMFNSiUN  nHAlM(12V) 

oortoli 

, 

fcOUIVAuniCL  ( {TRAIN, COlIN?) 

nonoi  ‘1 

c 

FILE  OrFMITtOMo  AND  RFCORD  LENGTHS' 

0 0 0 0 1 s 

COHtIUH  /FI|(S  / 

oonoi 6 

1 StGlO  ,LSF  ClO,riK)PW  ,LCR0RW,SUHHSr,LSU13H  , AClOy  T S » L ACQ 

000 01  7 

? fCAPiF  ,LCAMSF,CAKLPH,LCAHtRtCASF  ,LCASF  » YfcSOUl .LYLSO 

nono ) ii 

3 fSir.i  XT,LSlGtX,  Y1  St  RR,LYESf.R,StGlHU,LSLGIR,CASDIS»LCA3t) 

00001V 

4 fIN!>  jUUTP  .lAFlj  ,l.TAt;(i  , C aSOSF  t U C A SUS 

OOOORO 

INTFGrR  SF.GII'  ,CRUPH  t SURHS I t ACQH I S , C AHSF  ,CAnFRR,CASF  iYFSOUT 

0000?  I 

1 iSTGF  xT*  YLSEl'KiShGTRU,rASL)I6»(jUlP  tTACCJ  ,LASD5F 

OOOO?^ 

c 

0«00?3 

CnNMOM/TAC0/Ili01.O(4t  J?V7  t IHP 

00(I0?0 

INTFOrR  ArOtlOthlNOOW  • 

noooRli 

IHSF=1 

0 0fUl?6 

60  LONTIMOF 

nooo?  / 

lF(IPPi(>R(IHSE).NF.0,AND.IUSfc.LF.6I  60  TO  10 

0000?» 

63  CONTlMijr 

oooo?v 

IllSf  ~7 

0000  ?0 

HF TURN 

0000^1 

10  CONTINUE 

0000 

CALL  TsAVF(IPRlORaUSF)  , ItlRAO} 

000033  ^ 

IF  (TI5A0.6T,0)  GO  TO  66 

(100034 

c 

00003S 

c 

Finn  FIPsT  ACQUIS. DATE  ON. TRAINING  SEGMENT  .LF,  ACUUIS 

000036 

ITAC(J  = 0 

00003/ 

00  ?0  1 = It  WINDOW 

00005S 

DO  30  J=l,2'5 

00003V 

• IF  (I  IW1K( T , J) .1  0.0)  GO  TO  20 

000000 

IF  1 ACnijO.I  T , ITkINC  I , J)  ) ,GO  TO  40 

00004  1 

1TACU=ITWINU  *U) 

OOOOOi 

ISAV1,=  I 

000043  s 

JSAVkrj 

00O0O4 

30  coMTimjr 

OOOOOS 

20  CONTIHoF 

000046 

ir  ( I IWlW(HIMoOw,<:3)  .NF.O)  iTAC«=lTWlNCHlNI>0W,?5) 

000047 

40  CONTINIJF  ■ . 

000046 

IF  (lUcO.FO.o)  I'O  10  SO 

00004V 

on  43  1=1 f3 

OOOOMJ 

TH(I  ) = lNHf ItlSAVE .JSAVn 

OOOOS  1 

UK  I)  = flUK  If  iSAVt,  f JSAVI.) 

OOOOS2 

TVm=lVV(l,iSAYt»JSAVE) 

000033 

43  CONTlNljF 

000034 

c 

nofi()<->3 

c 

CMFCK  IF  OK  IPAlNING  ACQUIS. 

0 0 0 0 'i  6 

IDlFr=ACOMO-lTACH 

00O037 

lF(fOlFF.GT.lTN.\X)  GO  10  SO 

0 0 003(1 

■«0 

II 

c 

Cf'ltRHl. 
COURtL 
CfiRRiTL 
CfiRRhl, 
tORReL 
S(  GTHII 
5>F  OTRIt 
TFaFnS 
IF-AFnS 
IF  A I NS 
IflAlNvS 

trains 

TRAINS 
FILFS 
I ILFS 
FTIJ  S 
FILF& 
MLFS 
F TLFs 
MLF  S 
MLFS 
^ ILFS 

TAC  R 

CF'RRfL 

Lf'RR(-L 

U'URlL 

U'kRF.1. 

l-i’RKLL 

CORRfcL 

COHRlL 

LTHRLl. 

LflKHtl 

U'RRFL 

criRPtl. 

Cni-fRtL 

U'KPEL 

criRRti. 

COkRtL 

Cf'KlUL 

CdKRtU 

tfiKRF  L 

CnKRt'l 

tORRFL 

(.ORRtl. 

Ct'K’RE.L 

Cf'RRIlL 

Lf'RRUl. 

CCRRF.L 

COKRI  L 

LOKRF  1. 

CnuR{  L 

CFRRtL 

Ct'RRF'l 

LORfff  I. 

Ul'URtL 

{.OHRf.L 

LOrREL 

COkReL 


1% 


m 
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0000?9 

TCKTOKDsTl^CD^CTBdl+TVn)) 

LOHREL 

000060 

OS  CONTINUE 

CORRkl 

000061 

RETIIKN 

CORRtL 

000062 

•50  CONTINUI^ 

COKRhL 

OOOU65 

• Il)Sr  = UtSE+l 

CI'RRfL 

00  0 0 6 0 

■ • GO  TO  (>0 

COKRtl. 

00006t> 

£MO 

LOHRtL 
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000001 
000002 
000005 
00000^( 
oonoob 
000006 
000007 
OOnoOB 
000 00 V 
000010 
000011 
000012 
0000  1 5 
0000  1 0 
0000  I 5 
000016 
000017 
0000.10 
OOOO  1 9 
000020 
000021 
000022 
000023 
000024 
00002S 
000026 
000027 

oooo?a 

000029 

000030 

000031 

00O032 

00OO'<5 

000034 

O00o3b 
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00003B 


t 1 


SUBROUtINF  CR0P(5Et04,TYPEtSL-AS0NtWlNDaWtIf- IRSTtBCCtSIGCC  ' CROP 

. 1 tlisi-.ro  • CROP 

c ■ ■ CROP 

C THIS  SUOROUTIME  CALCULATES  THE  CROP  CALENDAR  FRROP  FOR  TRAINING  CROP 
C , StCiitiJTS.  X CROP 

C • ■ CROP 

C CAPS  CONTROL  CARD  INPUT  'DATA  CAMSCH 

COMHON/CAHSCH/  IHOOFL . IMULT 1 1 1 S iGFXt 1 SK IP t ITH AX f IPtP » I h I NO » CAJISCH 

1 ICROUPO, 2.  tbl  2»5)  f(.(3t2, 2)  2)  CARSCM 

RFAI  M$  CAHScH 

’ ’ c ■ ■ LAmSCM 

, ' COMMON/CROPK/CO!IN3fIRFG3f  I20N1  3tISTRA3»  ISUB3t  CI-UPK 

1 STAPT(2,4) ,EnO(2»4) ,So(2) rtRK(2»b)  CMUPR 

INTlOt'R  ST  AH  T f t ”()»  so  I FRO  CPuPR 

COHdUN/lRROP/TlTUO)  f IUATE,PtSTIH,TnT.  ALOCALff  KTOT(5)  LPROR' 

1 ttPtilAS(3)  if  RRAfilU  O ,CI  TOT  C5)  iCLOIAS(i)  » CLRANO  ( 3 ) t Ot  LT  A t LI-ROR 

1 LRl'PDi  7(3,2)i.NULT(3J,TI0ilRAlNAfTRAlNU  ERROR' 

DIMENSION  IFRS(OO)  ■ ERROR 

EOUTVAl FNCET I ITLf lERS)  ERROR 

RFAI  t-HU  1 ' ERROR 

INTfGfR  HDiCRllPU  error 

OOUHLF  PRICISION  SEED/I  ^ROP- 

INlrCER  TYPE iSEASONiRiNnOW  ■ tRUP 

C CROP 

C COMPU1L  dFLTA  T crop 

IFCIFlRSr.CT. 1 .OK.TYPF.Ct . 1)  GO  TO  JO  CROP 

CALI  HFTAn(SLEt)4,0.,0.if?Ni  liIFlO  CROP 

H Sf  C=iF  IX  (PN)  »SL>(SFaROM)  • CROP 

C CROP 

C COMPUTE  CROP  calendar  E.RRoR  CROP 

10  CONTifujE  • CROP 

CPOt'D-]  ISFG  -fRR(SEASOM,  WINDOW)  ■ CROP 

, DFLTA=  FLOATCCROt'D)  /F  LO  AT  C END  C 5E  A SON  t W I NOOW  ) - CPOP 

1 S I AkI (SLASONfW  INOOW)  + 1)  ' CROP 

l3CC=C{TYPE,Se  ASON.  1)»DU  I AYGnyPEiSEASUNiP)  * DF LT  AOOFL T A CROP 

SIGCC  = a?S(M(TYPE 1 SEASON, 1 ) ♦DEL  TA+  1|( I YPE i SEASON i2) ♦DEL TA+UELl A)  CROP 

I? F TURN  ' CROP 

END  , CROP 

, V. 
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FUR, IS  DETCLS 

SUBROUTINE  DETCLS  DEFCLS 

THIS  ROUTINE  DETERMINS  H'UW  MANY  CLASSES  THE  X ARRAY  XORD  CONTAINS  DETCLS 
AND  ASSIGNS  THE  CLASS  BCHIMDARY  POINTS  WITHIN  XORD.  DETCLS 

tables  MECCESSARY  to  determine  CLASS  SETS  WITHIN  A ZONE  CLSTAB 

COMMON  /CLSTAB/  • CLSTAB 

1 ISTRAT (300  ) , ISBSTR (3  00  > ,NSCNT( 300) , I GROUP ( 3 00) , lOATl (300) , MODI 

?.  IDAT2(  300  ) ,XORD  ( 300  ) , IXPT(  300  ) , IRANK(  3 00  ) , IBPT(  10)  , I EPT  ( 10  ) , MODI 

3 MAXCLS , ICLCNT , I StJ(-)l  ,NACQ  CLSTAB 

DIMENSION  DAT1(300) ,DAT2(300),RANK(300)  MODI 

EUU  I VALENCE  ( lOATl  ( 1 ) , DATl  ( 1 ) ) , ( I DAT  2 ( 1 ) , DAT2  ( 1 ) ) , { IRANI<(  1')  , CLSTAB 

IRANK(D)  ' . CLSTAB 

Flags  and  counters  for  cas  simulator  casflg 

COMMON  /casflg/  CASFLG 

1 H ,PPFLG  ,MBW  ,IBW  , WINDOW,  IPD  , I P.P  , PPDATE  ,NREGS  CASFLG 

2 ,NZTOT  ,MSTRAT,NYESSK,NSSHSK,NCAMSK,NRYES  ,NRSSH  ,NRCAMS  CASFLG 

3 ,ENDC  , ENDR£G,ENDZON, IRSTR  , I RZONE , I RREG  CASFLG 

4 ,LDS1  ,LDS4  ,LDS7  ,LDS8  ,L0S9  ,LDS10  ,LDS11  ,LDS12  ,LDS13  CASFLG 

5 ,LDS14  ,L0S15  ,LDS16  ,LDS17  , L RCOUM , L RREG  , LRZONE,LRSTR  CASFLG 

INTEGER  PPFLG  , WINDOW  , PPDATE  CASFLG 

casflg 

DIMENSION  ID( 10  ) ,IDOM( 10 ) DETCLS 

DETCLS 

• _ DETCLS 

DATA  CC/.25/  ' MODI 

THIS  DATA  IS  A BUILT  IN  CONSTANT,  IT  CAN  BE  MODIFIED  VIA  C OMP I LAT 1 1)£  TCLS 
5J?  sjc  DETCLS 

DETCLS 

IH  = H DETCLS 

DO  2 M = 1 ,10  MODI 

IBPT(M)  = 0 MODI 

IBPT(M)  = 0 MODI 

2 CONTINUE  MODI 

CO  = CC/NAC(0  MODI 

ICLCNT  = 0 DETCLS 

K = 1 DETCLS 

31=1  DETCLS 

7‘  IF(  (NACQ  -K)  .NE.  IRANK(I))GO  TO  25  DETCLS 

LB  = 0 ■ DETCLS 

lUB  = NACO  DETCLS 

IE{ ICLCNT  .LE.  0)G0  TO  20  DETCLS 


28234- 6029-RU-51 
Page  430 


DU  15  J=1,ICLCMT  DETCLS 

IF{IIMJ>  .LT.  non  TO  10  DETCLS 

lUB  = M1N0( lUBt ID( J ) ) ' DETCLS 

GO  TO  15  DETCLS 

10  LB  = MAXO(LB, ID< J ) ) DETCLS 

15'cONTINUe  ' DETCLS 

20  IP  = IXPT( I ) DETCLS 

IPl  = IXPT(I+1)  DETCLS 

lUBP  = IXPT(IUB)  . DETCLS 

LBPl  = IXPT(LB  + 1)  DETCLS 

IF((1  - LB)  .LT.  IH)GD  TO  25  . DETCLS 

IPIIIUB  - I)  .LT,  IH)GO  TO  25  • DETCLS 

IF(  ( XQRD(  IP  )-  XrjKD(LBPl))  .LT.  CO)GO  TO  25  MODI 

IF(  (XOKDI  lUBP  ) - XORD(IPl))  .LT.  CO)GO  TO  25  MODI 

ICLCNT  = ICLCNT  + 1 DETCLS 

IIKICLCNT)  = I - DETCLS 

IF( ICLCNT  .GT,  MAXCLS)GO  TO  30  DETCLS 

2 5 I -=  1 + 1 . DETCLS 

1F(I  ,LE.  {MAC0-1))G0  TO  7 DETCLS 

K = K + 1 DETCLS 

IF(K  .LE,  (NAC0-1))G0  TO  5 DETCLS 

30  IF{  ICLCNT  .EO.  0)GO  TO  40  DETCLS 

DU  35  I =1t ICLCNT  DETCLS 

IDUM(I)  = I DETCLS 

35  CONTINUE  DETCLS 

CALL  SORTAGI ID, 1, ICLCNT, IDUM)  DETCLS 

40  IBPT(l)  = 1 DETCLS 

IMAX'=  ICLCNT  + 1 DETCLS 

IRPTUMAX)  = MACO  .DETCLS 

IF(  ICLCNT  .EO.  0)GG  TO  55  DETCLS 

1=2  . DETCLS 

DO  50  J=l,  ICLCNT  I'FTCLS 

IBPT(I)  = lO(I-l)  + 1 DETCLS 

lEPT  U ) = ID(  I-l > DETCLS 

1=1+1  DETCLS 

50  CONTINUE  DETCLS 

55  ICLCNT  = ICLCNT  + 1 D.ETCLS 

60  RETURN  ’ DETCLS 

end  ' • DETCLS 
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IS  OSLO 

SUBkOUTiMe  DSIO  L)S10 

PROCESSES  DATA  SET  10 'AT  THE  STRATA  LEVEL  OSIO 

OSIO 

CAS  CONTROL  CARD  lNPliT-.QATA  AND  CONSTANTS  CASCM 

COMMON  /CASCM  / • CASCM 

1 AREACFtYCF  , PROOF  , APRlJTS  ( 4 , 2 ) , P PRUTS  ( 5 , 2 ) rYPRUTS(3t2)  CASCM 

2 , AKEAPS, S2MAX  »MHISTY,HH  ,TOPT  t AUN I TS , D I ST FF , B W I ND ( 4 ) CASCM 

3 ,WPK10R(4)  fAPREP  ,IPRD(3,14)  » MPDATE » PRDATE ( 14 ) CASCM 

iNTFGFk  HH,  TQPT»  AUN I TS » 0 1 ST F F r B WI NO . WPR I OR , APR EP » PRD ATE  CASCM 

CASCM 

DATA  BLOCK  FOR  CAS  CUMULATIVE  FILE  CASCUM 

CAS  DATA  SETS  14,  15,  16,  AND  17  . CASCUM 

COMMON  /CASCUM/  CASCUM 

1  CASCUM(32),'  BUFFR(504)  CASCUM 

DIMENSION  ICASC(32),  DSET14(22),  DSET15(22),  DSET16(22)  CASCUM 

1 ,DSET17(2B)  • CASCUM 

EQUIVALENCE  ( ICASC, CASCUM  ) CASCUM 

EQUIVALENCE  ( DSET 1 4 , DS E F 1 5 » 0 SET  16 , D SE T 1 7 , C ASCUM { 5 ) ) CASCUM 

1 , ( SQAERS,S0AERZ,SQAERR,S0AERC,CASCUM(24)  ) CASCUM 

2 , ( SOPERS, SQPERZ ,SQPERR, SOPERC,CASCUM( 25 ) ) ■ CASCUM 

3 » ( SQYERS,SQYFRZ,SQYERR,S0YERC,CASCUM(26)  ) CASCUM 

CASCUM 

FLAGS  AND  COUNTERS  FOR  CAS  SIMULATOR  ' CASFLG 

COMMON  /CASFLG/  CASFLG 

1 H ,PPFLG  ,NRW  ,IBW  , WINDOW, IPD  ,IPP  , P PDATE , NREGS  CASFLG 

2 ,NZTOT  ,NSTRArrNYESSK,NSSHSK,NCAMSK,NRYES  ,NRSSH  ,NRCAMS  CASFLG 

3 rENDC  , ENDR EG , ENDZON , I R ST R , I RZON E , I RREG  CASFLG 

4 ,LDS1  ,LDS4  ,LDS7  ,LDS8  ,LDS9  ,L0S10  ,L0S11  ,LDS12  ,LDS13  CASFLG 

5 ,LDS14  ,LDS15  ,LDS]6  ,L0S17  , LRCOUN , LRREG  , L R Z ONE , L RS TR  CASFLG 

INTEGER  PPFLG  , WINDOW  , PPDATE  CASFLG 

CASFLG 

CONTROL  PARAMETERS  FOR  LEM  PROGRAM  CNTRL 

COMM  UN  /CNTRL  / CNTRL 

1 PRINTF ,MSTART ,SEED (7  ) . CNTRL 

INTEGER  PRINTF  CNTRL 

DOUBLE  PRECISION  SEED  ' CNTRL 

CNTRL 

CAS  DATA 'sets  4,  5,  AND  6 (AT  STRATA  LEVEL)  DSET4 

COMMUN  /DSET4  / DSBT4 

1 STRATA, TWASl  ,HWAS1  ,EWAS1  ,XM1JS  ,XCT1S  ,ANVS1  JULY76 
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2 tTWAS2  ,HWAS2  tEWASZ  »XM2JS  ,XCT2S  ,ANVS2  ,T  JULY76 

3 , TWAS3  »HWAS3,-XCT3S 

4 ,XYS  rXESTYSrEVYRS  , P2 1 DPK  , VI V2S  ,VARS  tANVARS  JUI.Y76 

5 ,FILL4{57) 

INTEGER  STRATA  - JULY76 

DIMENSION  DSET4(24),  0SET5I7)»  DSET6(3)  JUI.Y76 

EQUIVALENCE  ( DSET4, STRATA  )»  ( DSET5,TWAS2  ),  { 0SET6rTWAS3  ) DSET4 
^ C ' ' DSET4 

C CAS  DATA  SET  7 (AT  ZONE  LEVEL)  DSET7 

COMMON  /DS6T7  / DSET7 

1 ZONE  ,HWAZ2  ,EZ  , M 1 K 2 KZ  » AN ALVZ  , NST R AZ  , H W AZ 1 ,EWAZ1  ,HWAZ3  jUt.Y76 

2 tESTVZ  ,HWAZ12  ' J0LY76 

3 ,M1K2CL(10)  ,EPWCL(10)  ,EPW2CL(10)  ,PKPICL(10)  JULY76 

'4  »PK2CL(10)  tPKCLdO)  ,SS(0(lO)  . JULY76 

INTEGER  ZONE  ’ JULY76 

REAL  MlK2KZt  MIK2CL  ' ‘ JULY76 

DIMENSION  DSET7(81)  JULY76 

EQUIVALENCE  ( DSET7,Z0NE  ) DSET7 

C DSET7 

C CAS  DATA  SET  8 (AT  REGION  LEVEL)  DSET8 

COMMON  /DSET8  / USET8 

1 REGION, HWAR2  , ER  , Ml K2KR , ANALVR , NZONES,  HWAR  1 ,EWAR1  ,ESTVR  JULY76 

. 2 ,M1M2ZR , FILLS (71 ) JULY76 

INTEGER  REGION  ' JULY76 

REAL  M1K2KR  • JULY76 

DIMENSION  DSETSdO)  ^ JULY76 

EQUIVALENCE  ( ' DS ET 8 , REGI ON  ) DS6T8 

C DSET8 

C CAS  DATA  SET  9 (AT  COUNTRY  LEVEL)  USET9 

COMMON  /DSET9  / DSET9 

1 C0UNTR,HWAC2  -,EC  ,M1K2KC,ANALVC,M1M2ZC,HWAC1  ,EWAC1  tESTvC  JULY76 

integer  COUNTR  JULY76 

REAL  M1K2KC  JULY76 

DIMENSION  DSET9(9)  ' • JULY76 

EtOUIVALENCE  ( 0SET9, COUNTR  ) 0SET9 

C ' DSET9 

C CAS  DATA  SET  10  (STRATA  DATA  — FINAL  PASS)  . JULY76  • 

COMMON  /DSETIO/  JULY76 

1 HWAS  ,TWAS  ,FWAS  ,AERRS  , AVARS  , TPRODS , E PRODS , PR  ERRS , PRVARS  JULY76 

2 ,YS'  tESTYS  ,YERRS  ,M1JS  ,M2JS  ,CT1S  ,CT2S  ,CT3S  ,ANAVS  JULY76 

3 ,ANPRVS,ES  JULY76 
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REAL  MIJS  » Ki2JS  JULY76 

DIMENSION  DSET10{20)  . JULY76 

EOUIVALENCE  ( DSET10,HWAS  ) ' ' JULY76 

OSETIO 

CAS  DATA  SET  11  (ZONE  DATA  — FINAL  PA'SS)  . J0LY76 

CUMMUN  /DSETll/  • DSETll 

1 HWAZ  tTWAZ  fEWAZ  ,A6RRZ  »AVARZ  » T P R DD Z , E PRODZ » PR ERRZ , PRVARZ  DSETll 

2 »TYZ  tEYZ  ,YERKZ  tMIZ  ,M2Z  tCTIZ  ,CT2Z  ,CT3Z  tANAVZ  DSETll 

3 tANPRVZ  DSETll 

REAL  MIZ  r M2Z  . DSETll 

DIMENSION  DSET11{]9)  , DSETll 

E DU  I VALENCE  ( DSETll, HWAZ  ) DSETll 

■ ' DSETll 

file  DEFINITIONS  AND  RECORD  LENGTHS  FILES 

COMMON  /FILES'/  FILES 

1 SEGID  ,LSEGID,CR0P  W , LCROPW , SUBHS  T , L SUBH-  , ACQUIS, LACQ  FILES 

2 ,CAMSF  ,LCAMSF,CAMERR,LCAMER,CASF  ,LCASF  , Y ESOUT , LY ES □ FILES 

3 ,S1GEXT,LSIGEX,YESERR,LYESER, SEGTRU,LSEGTR,CASDIS,LCASD  FILES 

4 ,INP  ,GUTP  ,TACO  ,LTACO  ,CASDSF ,LCASDS  FILES 

INTEGER  SEGID  ,CRC1PW  , SUBHST  , A'C  OU  I S , C AMSF  ,CAMERR,CASF  ,YESOUT  , FILES 

1 ,SIGEXT,YESERR,SEGTRU,CASDlS,OUTP  ,TACO  ,CASDSF  'fILES 

files 

INDEX  RECORD  FOR  CAS  CUMULATIVE  FILE  (CASE)  IXCASF 

COMMUN  /IXCASF/  , IXCASF 

1 I XCASF { 1 ) ,LIXCAS 

IXCASF 

INDEX  RECORD  FOR  CAS  INTERMEDIATE  DATA  SET  FILE  (CASDSF)  IXCDSF 

CUMMUN  /IXCDSF/  ' . IXCDSF 

1 IXCDSF ( 1 ) ,LIXCDS 

IXCDSF 

STATISTICAL  INFORMATION  FOR  LEM  STATS 

CUMMUN  /STATS  / STATS 

1 ITER  ,NSEGTR,MCAMSR,NYESR  , NREC ( 7 ) , NC ASCR ,NCAS DR  STATS 

EQUIVALENCE  ( NT, ITER  ) . STATS 

STATS 

DEBUGGING  PRINT  FLAG  USlO 

COMMON  /DEBUGF/  DEI3UGF  . DSIO 

OS  10 
DSIO 

LOCAL  VARIABLES  DSIO 

D = INTERMEDIATE  QUANTITY  USED  TO  COMPUTE  TAU2S  DSIO 
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C 

C 

C 

c 

c 

c 

c 

,c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

200 


(D  = 0 OK  1 DEPENDING  UPON  NO.  OF  ACQUIRED  GROUP  1 »2  OSIO 
SEGMENTS  IN  STRATA)  OS  10 

DENIJM  = DENOMINATOR  OF  RATIO  USED  TO  COMPUTE  TAU2S  AND  SIGM2S  DSIO 

F = INTERMEDIATE  QUANTITY  U^ED  TO  COMPUTE  ANAVS  DSIO 

(=  ANALV  at  STRATA,  ^ONE,  REGION,  OR  COUNTRY  LEVEL)  DSIO 
FM  = NHISTY  (IN  FLOATING  POINT)  . DSIO 

HWAS12  = HWASl  + HWAS2  DSIO 

HWA12  = HWAIJ  + HWA2J  (WHERE  J = S,  Z,  R,  OR  C)  • DSIO 

I = DO  LOOP  INDEX  DSIO 

ISTRAZ  = ZONE  INDEX  { 1 , 2 , . . . , NS TR AZ 1 DSIO 

MYV12  = MYVLJ  + MYV2J  (WHERE  J = S,  Z,  R,  OR  C ) DSIO 

NU  = DO  LOOP  (YEAR)  INDEX  IN  MULTI-YEAR  VARIANCE  LOOP  DSIO 

RATIO  = INTERMEDIAfE  QUANTITY  USED  TO  COMPUTE  TAU2S  AND  SIGM2SUS10 

RNl  = RANDOM  NUMBER  IN  NUMERATORS  OF  RATIOS  IN  EXPRESSIONS  DSIO 

FOR'  TAU2S  AMD  SIGM2S  DSIO  ' 

RN2  .=  RANDOM  NUMBER  IN  DENOMINATORS  OF  RATIOS  IN  EX  PRESS  I ONSDS  10 
FOR  TAU2S  AND  SIGM2S  DSIO 

SRMV12  = SORT.  OF  MULTI-YEAR  VARIANCE  FOR  GROUP  1,2  SEGMENTS  DSIO 
AT  STRATA,  ZONE,  REGION,  OR  COUNTRY  LEVELS  DSIO 

SKMYV3  = SORT.  OF  MULTI-YEAR  VARIANCE  FOR  GROUP  3 SEGMENTS  DSIO 

AT  STRATA,  ZONE,  REGION,  OR  COUNTRY  LEVELS  DSIO 

SUMl  = SUM  OF  TERMS  IN  EXPRESSION  FOR  TAU2S  BEFORE  DIVIDING  DSIO 
BY  M.  DSIO 

SUM2  ' = FIRST  SUM  IN  EXPRESSION  FOR  SIGM2S  (SUM  OF  RATI0'i":'2)  DSIO 
SUM3  = second'  SUM  IN  EXPRESSION  FOR  SIGM25  (SUM  OF  RATIOS)  DSIO 
TERMl  = INTERMEDIATE  QUANTITY  USED  TO  COMPUTE  PRVARS  AND  DSIO 

ANPRVS  (=EVYRS  + ESTYS-”^2)  DSIO 

■ TERM2  ■=  INTERMEDIATE  QUANTITY  USED  TO  COMPUTE  PRVARS  DSIO 

( =EVYRS*EWAS’i“^2  ) DSIO 

DSIO 

REAL  MYV12  DSIO 

DSIO 

DSIO 

COMPUTE  INTERMEDIATE  QUANTITY  USED  TO  COMPUTE  AVARZ  LATER, ON.  JULY76 
CUNZ  =1.0  JULY76 

IF  ( HWAZ12  .ME.  0.0  ) CnNZ=  1.0  + HWAZ3/HWAZ12  JULY76 

JULY76 

*‘ISTRAZ=  0 . DSIO 

INITIALIZE  DATA  SET  10  (STRATA  LEVEL)  ' DSIO 

ISTRAZ=  ISTRAZ  + 1 • DSIO 

DO  210  I=1,LDS10  DSIO 


28234-6029 -RU -51 
Page  432 


c~)0  ‘ ooOdo  oO 


DSETLO( I)=  0.0  OSIO 

210  CONTINUE  OS  10 

US  10 

READ  DATA  SETS  4t5»  AND  6 FRfJM  CAS  INTERMEDIATE  FILE  DSIO 

IRSTR  = IRSTR  + 1 USIO 

CALL  RANACF  ( C ASDSF , I RSTR , DSE T4 , L C AS DS , I XC DSF , L I X CDS t 1 ) USIO 

USIO 

GENERATE  DATA  SET  10  (STRATA  LEVEL)  ' DSIO 

DSIO 

MUVE  YSt  ESTYSt  MIJS,  M2JS,  CTIS,  CT2S.  AND  CT3S  DSIO 

FROM  DATA  SETS  4,5,6  TO  DATA  SET  10  . DSIO 

YS  = XYS  • ■ DSIO 

ESTYS=  XESTYS  DSIO 

MIJS  = XMIJS  DSIO 

M2JS  = XM2JS  - ’ . DSIO 

CTIS  = XCTIS  .■  DSIO 

CT2S  = XCT2S  DSIO 

CT3S  = XCT3S  DSIO 

HWAS12=  HWASl  + HWAS2  DSIO 

HWAS  = HWAS12  + HWAS3  JULY76 

DSIO 

CUMRUTE  ES  (EO.  90)  DSIO 

IF(  M1JS  + M2JS  .EO.  0.0  .OR.  HWAS12  .EO.  0.0  ) GO'  TO  232  DSIO 

C MIJS  + M2JS  .GE.  1 (AT  LEAST  ONE  ACQUIRED  SEGMENT  -IN  STRATA)  DSIO 

ES=  { eWASI  + EWAS2  ) / HWAS12  DSIO 

GO  TO  240  DSIO 

C MIJS  + M2JS  =0.  NO  ACQUIRED  SEGMENTS  IN  STRATA.  DSIO  ' 

232  IF  ( .M1K2K2  .EO.  0.0  ) GO  TO  234  , DSIO 

C SUM  OF  MIK  + M2K  .GE.  1.  AT  LEAST  ONE  ACQUIRED  SEGMENT  IN  ZON6DS10 

ES=  EZ  ' DSIO 

GO  TO  240  DSIO 

C M1K2KZ  = 0.  MO  ACQUIRED  SEGMENTS  IN  ZONE  i D 

234  IF  ( M1K2KR  .EO.  0.0  ) GO  TO  236  DSIO 

C SUM  OF  MIK  + M2K  .GE.  1.  AT  LFAST  ONE  ACQUIRED  SEGMENT  IN  REG. DSIO 

ES=  ER  DSIO 

GO  TO  240  . DSIO 

C M1K2KR  = 0.  NO  ACQUIRED  SEGMENTS  IN  REGION  USIO 

236  ES=  EC  ■ ■ D’SIO 

C ' DSIO 

240  IF  ( M1M2ZC  .£Q.  0,)  GO  TO  320  DSIO 

C DSIO 
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IF  ( M1K.2KZ  .LT.  2.0  ) GO  TO  250  JULY76 

IF  ( MIJS  + M2JS  .GT.  0.0  ) GO  TO  260  JULY76 

GUMPUTE'aREA  variance  and  analytic  area  variance  of  strata  JULY76 

WITHOUT  AMY  ACQUIRED  SEGMENTS  ( OR  STRATA  IN  A ZONE  WITH  LESS  JULY76 
THAN  2 ACQUIRED  SEGMENTS)  • JULY76 

(THE  AREA  VARIANCE  OF  STRATA  WITH  SEGMENTS  HAS  ALREADY  BEEN  JULY76 
COMPUTED  IN  SUBROUriNE  CAS2)  ' JULY76 

2b0  IF  ( HWAZ12  .EO.  0,0  ) GO  TO  320  JULY76 

WRATIO  = ( HWAS/H'WAZ12  ) *-'2  JULY76 

AVARS  = WRATIO*6STVZ  • JUI.Y76 

ANAVS  = WRAT  lO'l'ANALVZ  . JULY76 

GU  TU  320  ' JULY76 

JULY76 

AT  LEAST  ONE  ACQUIRED  SEGMENT  IN  STRATA  AND  AT  LEAST  TWO  JULY76 

IN  ZONE,  ' JULY76 

ADD  CONTRIBUTION  OF  THIS  STRATA  TO  ZONE  AREA  VARIANCE  JULY76 

260  AVARS  = VARS  JULY76 

ANAVS  = ANVARS  ’ JULY76 

VZMULT=  ( CONZ  + HWAS3/HWAS12  )=:'=^2  JULY76 

AVARZ  = AVARZ  + VI  V2S ’i'VZ MUL T , . JULY76 

ANAVZ  = ANAVZ  + ( A NV S 1 +AMV S2  ) *V ZMULT  ’ - JULY76 

DSIO 

COMPUTE  HWAS,  TWAS,  ...  t ANPRVS  (EQS.  94-105)  DSIO 

320  HWAS=  HWAS12  + HWAS3  ' ' DS10 

TWAS=  TWASl  ’+  TWAS2  + TWAS3  DSIO 

EWAS=EWAS1  + EWAS2  + ES'^HWAS3  . DSIO 

AERRS=  EWAS  - TWAS  DSIO 

TPRODS=  YS=:=TWAS  • DSl'O 

EPRODS=  ESTYS*EWAS  . DSIO 

PRERRS=  EPRODS  - TPRODS  DSIO 

TERMl  = ES1YS*ESTYS  - EVYRS  ■ JULY76 

TEKM2  = EWAS*EWAS=l-EVYRS  DSIO 

PKVARS=  AVARS'i<TERMl  + TERM2  DSIO 

IF  ( YS  .GT.  0.0  I YERRS=  ( ESTYS  - YS  )/YS  *100.0  DSIO 

ANPRVS=  ANAVS*TERM1  + TERM2  DSIO 

DSIO 
D'Sl  0 

temporary  DEBUGGING  PRINTOUT  ' DSIO 

DSIO 

DSIO 

AGGREGATE  STRATA  DATA  SET  10  UP  TO  DATA  SET  11  (ZONE  LEVEL)  DSIO 
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C EOS.  106  - 108,  110  - 112,  114,  118  - 124  OSIO 

DU  340  1=1,4  JULY76 

DSETll  ( I )="  OSETll  ( I ) +DSEn0(I)  JULY76 

DSETll(I+5)=  DSETll(I+5>  + DSET10(I+5)  JULY76 

340  DSETIK  I + 12)=  DSET 1 1 { I + 12-)-,  + D SET  10  ( I + 1 2 ) JULY76 

■ CT3Z  = CT3Z  + CT3S  JULY76 

ANPRVZ=  AMPRVZ  + 'ANPKVS  . • JULY76 

OS  10 

ON  PIRST  ITERATION  AND  FIRST  PREDICTION  POINT,  SKIP  READING  U5I0 

CAS  CUM.ULATIVE  FILE.  , OS  10 

IF  { NT  .EO.  1 .AND.  IPP  .EO.  1 ) GO  TO  350  OSLO 

OS  10 

READ  DATA  SET  15  (STRATA  DATA)  FROM  CAS  CUMULATIVE  FILE  DSIO 

• NUTE  ...  EQUIVALENCE  ( DSE T 1^ , C ASCUM ( 5 ) ) OSlO 

CALL  RWCASF  ( I RSTR ,C ASCUM , 1 ) OSIO 

DSIO 

ACCUMULATE  STRATA  DATA  IN  DATA  SET  14  (CAS  CUMULATIVE  FILE)  DSIO 
IF  ( NT  .GT.  1 ) GD  TO  370  DSIO 

FIRST  ITERATION.  CLEAR  DATA  SET  14  BEFORE  ACCU('UJLATI  NG  DSIO 

350  ICASC(1)=  REGION  DSIO 

ICASC(2)=  ZONE  DSIO 

t ICASC(3)=  STRATA  DSIO 

. ICASC(4)=  0 . DSIO 

DU  360  I=1,LDS14  DSIO 

DS6T]4{ I ) = 6.0  DSIO 

360  CONTINUE  DSIO 

DSIO 

370  DU  380  1=1,19  DSIO 

DSET14(I)=  DSET14(I)  + DSETIO(I)  JULY76 

380  CONTINUE  DSIO 

EOS.  170  - 172  DSIO 

S(OAEkS=  SOAEKS  + AERRS'^^2  DSIO 

SOPERS=  SOPERS  + PRERRS**2  DSIO 

SQYEKS=  SOYERS  + YERRS*42  DSIO 

OSIO 

DSIO 

TEMPORARY  DEBUGGING  PRINTOUT  DSIO 

DSIO 

DSIO 

WRITE  DATA  SET  14  BACK  ONTO  CAS  CUMULATIVE  FILE  ■ DSIO 

CALL  RWCASF  ( IRSTR ,C ASCUM , 2 ) DSIO 
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IF  ( PRINTF  .ME.  0 .AMO.  APREP  .ME.  0 
C TEST  FOR  END  OF  ZONE 

IF  { ISTKAZ  ,LT.  NSTRAZ  ) GO  TO  200 
C . 

990  RETURN 
, END 


> CALL  CASOUT  (ISTRAZ) 


OSIO 
DSIO 
US  10 
DSIO 
DSlO 
OSIO 
DSIO 
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C 

C 


IS  0S123 

SUBHUUTINE  DS123 

PROCESSES  DATA  SETS  It  2t  AND  3 AT  THE  SUBSTRATA  LEVEL 

ARGUMENT  LIST  FOR  ERROR  PROCESSING 
COMMON  /ARGLST/ 

1  NERRS  tMFATALtNPERRS tNARG  tARG(IO) 

DIMENSION  - I ARC (10) 

E(0U  IVALENCE  ( IARGtARG.) 

CAS  CONTROL  CARD  INPUT -DATA  AND  CONStANTS 
CUMM(JN  /CASCM  / 

1 AREACFtYCF  tPROCF  ,APRUTS(At2)  »PPRUTS(5t2 ) tYPRUTS(3»2) 

2 t AKEAPS, S2MAX  tNHISTYtHH  ,T0PT  , AUN I TS , D I ST FF , B WI ND ( 4 ) 

3 tWPRIGR(4)  - tAPREP  ,IPRD(3t14)  tNPDATE t PROATE ( 14 ) 

INTEGER  HHt  TOPT,  AUN  I TS  , D I ST  F F , B W I ND , ,WPR  I OR  , A PR  EP  , PRDATE 

DATA  BLOCK  FOR  CAS  CUMULATIVE  FILE 
CAS  DATA  SETS  '14,  15,  16,  AND  17 
COMMON  /CASCUM/ 

1  CASCUM (32),  BUFFR(504) 

DIMENSION  ICA$C(32),  DSET14(22),  DSET15(22),  DSET16(22) 

1 ,DSETI7(28) 

E(0UIVALENCE  ( ICASC, CASCUM  ) 

E(OU  IVALENCE  ( OS E T 14  , DS ET  1 5 , D SET  16  , DSE T 1 7 , C ASCUM  ( 5 ) ~) 

1 , ( SOAERS,SOAERZ,SQAERR,SOAERC,CASCUM(24)  ) 

2 , ( SUPERS, SQPERZ, SOPERR, SOPERC, CASCUM! 25 ) ) 

3 , ( SQYERS,SOYERZ,SOYERR,SOYERC,CASCUM(26.)  ) 

DATA  BLOCK  FOR  CAS  DISTRIBUTION  FILE  (DATA  SET  19) 

DIMENSION  CASDSB(303) 

E(0UI  VALENCE  ( CASDSR,RUFFR  ) 

DIMENSION  ICASD(303),  HWA2K('60),  WAKNEY(60),  PIK(60) 

EUUIVALENCE  ( I C A SD , H W A2K , C A SOS B ),  ( WAKNEY , CASOSB ( 61  ) ) 

1 , ( PIK ,CASDSB( 121  ) ) 

FLAGS  AMD  COUNTERS  FOR  CAS  SIMULATOR 
COMMON  /CASFLG/ 

1 H ,PPFLG  ,NBW  ,IBW  , WINDOW,  I’PD  ,IPP  , PP  DATE , NREGS 

2 ,NZTOT  ,MSTRAT,NYESSK,MSSHSK, NCAMSK, MRYES  ,NRSSH  ,NRCAMS 

3 tENDC  tENDREGtENOZON, IRSTR  , IRZOME , IRREG 


DS123 

DS123 

DSL23 

ARGLST 

ARGLST 

ARGLST 

ARGLST 

ARGLST 

ARGLST 

CASCM 

CASCM 

CASCM 

CASCM 

CASCM 

CASCM 

CASCM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM 

CASCUM- 

CASCUM 

CASCUM 

CASCUM 

CASDSB 

CASDSB 

CASDSB 

CASDSB 

CASDSB 

CASDSB 

CASDSB 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 


• UT 
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4 ,LDS1  ,1-054  ,1-057  ,L058  ,LDS9,  ,LD510  ,LD511  ,LDS12  ,LD513  CASFLG 

5 ,LDS14  ,LDS15  ,LDS16  ,10517  , L RC GUN , L RRE G , LRZONE , L RS TR  CASFLG 

INTEGER  RPFtG  , WINDOW  , PPDATE  CA5FUG 

CA5FLG 

CONTROL  PARAM6TER5  FOR  LEM  PROGRAM  . CNTRL 

COMMON  /CMTKL  / ' CNTRL 

1  PRINTF ,M5TART,5EED(7)  CNTRL 

INTEC7EK  PRINTF  ' . CNTRL 

DOUBLE  PRECISION  SEED  CNTRL 

CNTRL 

CAS  DATA  SETS  1,2,  AND  3 . DSETl 

COMMON  /DSETl  / , DSETl 

1 ISUBSTf'TWAK  ,HWAK  ,EWAK  ,M1K  ,CT1K  , AN  ALVK , EP  W><  ,EPW2K  JULY76 

2 ,SMPKPI,SUMPK2,SUMPK  ,KSUB  ,NCLASS  JULY76 

REAL  MIK  , M2K  JULY76 

DIMENSION  DSET1(14>,  DSET2(14),  DSET3(.6)  ' ■ JULY76 

EOUIVALENCE  ( DSETl, DSET2, DSET3, ISUBST  ) DSETl 

1 , ( M2K,M1K  ),  { CT2K,CT3K,CT1K  ) DSET) 

DSETl 

CAS  DATA  SETS  4,  5,  AND  6 (AT  STRATA  LEVEL)  DSET4 

COMMON  /DSET4  / ' DS6T4 

1 STRATA, TWASl  ,HWAS1  ,EWAS1  ,XM1JS  ,XCT1S  ,ANVS1  JULY76 

2 ,TWAS2  ,HWAS2  ,EWAS2  ,XM2JS  ,XCT2S  ,ANVS2  ,T  JULY76 

3 , TWAS3,HWAS3,XCT3S 

4 ,XYS  ,XESTYS,EVYRS  , P 2 1 DPK  , V 1 V 2 S ,VARS  , ANVARS  'JULY76 

5 ,FILL4(57) 

integer  strata  JULY76 

DIMENSION  DSET4(24),  DSET5(7),  DSET6(3)  JULY76 

equivalence  ( DSET4, STRATA  ),  ( DSET5,TWAS2  ),  { DSET6,TWAS3  ) DSET4 

DSET4 

CAS  DATA  SET  7 (AT  ZONE  LEVEL)  DSET7 

CUMf'lOM  /DSET7  / PRFTT 

1 ZONE  ,HWAZ2  ,EZ  ,M1 K2KZ , ANALVZ ,NSTRAZ ,HWAZ 1 , EW AZ 1 • , HW AZ3  JULY76 

2 tESTVZ  ,HWAZ12  • . JULY76 

3 ,M1K2CL(10)  ,EPWCL(10)  ,EPW2CL(10)  ,PKPICL(10)  • . JULY76 

4 ,PK2CL(10)  ,PKCL(10)  ,SS0(1U)  JULY76 

INTEGER  ZONE  ' ' JULY76 

REAL  M1K2KZ,  M1K2CL  ‘ ‘ JULY76 

DIMENSION  bSET7(8  1)  JUI.Y76 

E(=)UIVALENCE  { DSET7,Z0NE  ) DSET7 

C DSET7 
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C 


C 

C 


C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 


FILE  DEFIMITinMS  AMQ  RECORD  LENGTFkS  FILES 

COMMUN  /FILES  / FILES 

1 SEGiD  ,lsegio,cropw  ,lcrdpw , sljbhst tLSubh  ,acouis,lacq  files 

2 tCAMSF  ,LCAMSF tCAMERR^LCAMERt CASF  ,LCASF  , YE SOUT , L YE  SO  FILES 

3 tSIGEXT ,LS IGEX, YESERR,LY£SER»  SEGTRU ,LSEGJR ,CASDI S »LCASD  FILES 

4 ,INP  ,OUTP  tTACO  ,LTACQ  , C ASDS F , LC AS DS  • FILES 

INTEGER  SEGID  rCRDPW  , SUBH  ST  t ACQIJ I S , C AMS  F ,CAMERR,CASF  ,YESOUT  FILES 

1  , SIGEXTtYESERR, SEGTRU,CASDIS,nUTP  ,TACQ  ,CASDSF  FILES 

FILES 

INDEX  RECORD  FOR  INTERMEDIATE  SUBSTRATA  HISTORICAL  DATA  FILE  IXSUBH 

COMMON  /IXSUBH/  ' . IXSUBH 

1 L IXSSH, IXSUBH ( 1 ) MODI  , 

IXSUBH 

CUMMOM/FILESI/  FILESI 

1 ISUBH2,LSUBH2tM-X,CLSS  FILESI 

SUBSTRATA  HISTORICAL  DATA  FROM  SUBHST  FILE  SSHDTA 

COMMON  /SSHDTA/  SSHDTA 

1 CU(JN2  tIREG2  , IZ0ME2,  ISTRA2'»  ISUBS2,MSEG  tIDSEG  ,GRPNO  tHISTPW  SSHDTA 

2 ,AREAK  ,PWK  tNAGR  ,NA  , DELT PW » DELTPM , CV 1 »CV2  »CV3  SSHDTA 

3 ,CV4  , VMULTK, CLASS! 18) ,MXK, RDSSH  JULY76 

'INTEGER  GRPNO  , CLASS  t RDSSH  JULY76 

DIMENSION  SSHDTAI39)  JULY76 

EOUIVALENCE  ( SSHDTA,  CGUN2  ) SSHDTA 


SSHDTA 
DS12  3 
DS123 
DS123 
DS123 

) DS123 

DS123 

US123 

IS  CONSTANT  FOR  A GIVEN  SUBSTRATA  DS123 

SEGMENT  (=NK’!'RK^'AREAPS  WHERE  NK  = NAGR)DS123 
PT,)  OS123 

DS123 

0 FOR  NON-FATAL  ERROR,  =1  FOR  FATAL)  - DS123 

OS  12  3 

ORTION  WHEAT  ( PW ) FOR  NON-EPOCH  YEAR.  DS123 

US123 
DSl  23 

nON  FOR  BETA  DISTRIBUTION  ROUTINE.  DS123 


DEBUGGING  PRINT  FLAG 
COMMON  /DEBUGF/  DERUGF 


E GUI VALENCE  ( IER,IARG(1) 

LOCAL  VARIABLES  • 

CONK  = GUANTITY  WHICH 
INDEPENDENT  OF 
FNK  = NK  = NAGR  (FL. 
I = DO  LOOP  INDEX 

LEVEL  = ERROR  LEVEL  {= 
M2  = M2K  ( I NTEGER ) 

PWKNEY  = SUBSTRATA  PROP 
RK  ='rK  (EfO.  1) 

RKSO  = (RK=!'AREAPS  )-’:'2 
SIGMA  = STANDARD  DEV  I A 
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DS123 

ARRAY  FOR  SAVING  HISTPWt  PWK,  AND  AREAK  BEFORE  CONVERTING  JULY76 

FROM  percent  to  FRACTION.  JULY76 

DIMENSION  SSHSAVO)  JULY76 

JULY76 
OS  123 

DO  210  I=2,Lbsl  DS123 

OSETl  ( 1 )=  0.0  DS123 

210  CONTINUE  DS123 

DS123 

ISUBST=  ISUBS2  DS123 

SSHSAV(l)  = HISTPW  JULY76 

SSHSAVI2)  = PWK  JULY76 

SSHSAV(3)  = AREAK  JULY76 

CONVERT  HISTPW  AND  PW  TO  FRACTIONS  FROM  PERCENT.  DS123 

HISTPW=  0,01 -HISTPW  . ' DS123 

PWK=  O.Ol^PWK  0S123 

CONVERT  SUBSTRATA  LAND  AREA  TO  HECTARES  FROM  KM>:>*2  DS123 

AREAK=  100.0*AREAK  DS123 

EO.  1 DS123 

RK=  AREAK/ ( Fl_0 AT  { NA  ) *AR EAP S ) ' ' DS123 

RKS(0=  (,RK=:=AREAPS  )--2  OS  123 

FNK=  MAGR  DS123 

CCJNK=  FNK^^RK-AREAP'S  ■ DS123 

EOS.  7,  8,  AND  10  DS123 

TWAI<=  CONK'^PWK  DS123 

HWAK=  CONK*HISTPW  DS123 

CT1K=  1.0  DS123 

DS123 

TEST  GROUP  NUMBER  AND  GENERATE  DATA  SET  1,  2,  OR  3 DS123 

IF  { GRPNO  - 2 ) 310»350»390  DS123 

pc  1 ?3 

GROUP  I SUBSTRATUM  DS123 

CHECK  THE  NUMBER  OF  SEGMENTS  IN  THIS  SUBSTRATUM  DS123 

310  IF  ( NS6G  ,GT.  0 ) GO  TO  320  DS123 

fatal  ERROR.  NO  SEGMENTS  IN  SUBSTRATUM  DS123 

CALL  ERRM6S  ( 3HCAS ,5HDS 123t 13 t 1 ) • US123 

GU  TO  990  ■ ■ . DS123 

US  12  3 

PROCESS  ALL  SEGMENTS  IN  THIS  GROUP  I SUBSTRATUM.  DS123 

EOS.  2A  - 6A  ’ DS123 
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320 

C 

c 


345 

350 


3 60 


370 


CALL  GROUP  OS  123 

IP  ( NFATAL  .NE.  0 ),  GO  TO  990  DS123 

WERE  AMY  GROUP  I SEGMENTS  ACQUIRED  FOR  THIS  SUBSTRATUM  US123 

IP  ( MIK  .EO.  0.0  ) GO  TO  390  . DS123 

GENERATE  REST  OF  DATA  SE.T  1 (GQS.  9,  11,  AMO  12)  • DS'123  ■ 

EWAK=  C0NK*EPWK/M1K  DS123 

,VMULTK=  ( FNK  - MIK  ) ’i'RK S Q^-'FN K /M  IK  ’ ' . DS123 

ANALVK=  VMULTK'M  PWK*CV2  )**:^2  DS123 

OS  123 

AGGREGATE  SUBSTRATA  DATA  SET  1 INTO  DATA  SET  4 (STRATA  LEVEL)  DS123 
( TWAK,HWAKtEWAKrMlK,MYVK,VMlJLTK,CTlK,  AMALVK.  ) 0S123 

(EOS.  19-25,  37)  DS123 

DU  345  1=2,7  JULY76 

DSET4(I)=  DSET4(I)  + DSETl(I)  DS123 

CONTINUE  . ■ 0S123 

GO  TO  385  , JULY76 

IJS123 

GROUP  II  SUBSTRATUM  DS123 

CHECK  THE  NUMBER  Of  SEGMENTS  IN  THIS  SUBSTRATUM  DS123 

IF  ( NSEG  ,EQ.  0 ).  GO  TO  360  0S123 

PROCESS  ALL  GROUP  II  SEGMENTS  IN  THIS  SUBSTRATA  0S123 

EQS.  2B  - 68  DS123 

CALL  GROUP  DS123 

IF  ( NFATAL  .NE.  O')  GO  TO  990  • DSI23 

OS  123  ■ 

generate  rest  of  DATA  SET  2.  DS123 

IF  (,  TUPT  .EQ.  0 ) GO  TO  370  0S123 

JULY76 

COMPUTE  NON-EPOCH  YEAR  WHEAT  AREA  JULY76 

KSUB  = KSU8  + 1 JULY76 

WAKNEY(KSUB)  = CV4''!‘HWAK  JULY76 

HWA2K(KSUB)  = HWAK 

DS123 

EQN.  16  ( DEFER  DIVISION  BY  HWAK  UNTIL  AFTER  ANALVK  COMPUTED  )DS123 

VMULTK=  ( FNK«FNK  - FNK  )':‘RKSO  OS  123 

EQN.  17  . D-S123 

ANALVK=  VMULTK>:M  PWK>:‘CV2  )>I«»2  . US123 

VMULTK=  VMULTK/HWAK  ‘ ’ 0S123 

DS123 

aggregate  SUBSTRATA  DATA  SET  2 INTO  DATA  SET  5 (STRATA  LEVEL)  DS123 
E(ONS.  31,32,34,35  ,36,38,40  0S123 
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DO  380  I=l»6  JULY76 

DSET5(1  1=  DSET5(I  ) + DSET2(I+1)  DS123 

380  CONTINUE  ' . DS123 

NOTE...  AT  THIS  POINT  EWAS2  HAS  MOT  BEEN  COMPUTED  YET  AMD  • DS123 

VMULTK  AND  ANVS2  (EOS.  36  AND  40)  ARE  INCOMPLETE  JULY76 

(COMPLETED  IN  SUBROUTINE  CAS2)  JULY76 

P2IDPK=  P2IDPK  + EPWK/HISTPW  . DS123 

JULY76 

385  M 1K2CL  ( NCLASS  )=  M1K2CL,(  NCLASS  ) + M2K  JULY76 

EPWCL (NCLASS ) = EPWCL ( NCLASS ) + EPWK  JULY76 

EPW2CL( NCLASS )=  EPW2CL ( NCLASS ) + EPW2K  . JULY76 

PKPICL  (NCLASS  )=  PKP  I CL  ( NCL  A S S ) + SMPKPI  ‘JULY76 

PK2CL( NCLASS ) = PK 2CL ( NCLAS S ) + SUMPK2  JULY76 

PKCL (NCLASS)  = PKCL( NCLASS)  + SUMPK  JULY76 

RESTORE  ORIGINAL  VALUES  BEFORE  WRITING  BACK  ONTO  iSUBHZ  FILE  JULY76 
HISTPW  = SSHSAV(l)  . JULY76 

PWK  = SSHSAV(2)  JULY76 

AREAK  = SSHSAV(3)  JULY76 

WRITE  SUBSTRATA  DATA  BACK  ONTO  ISUBH2  FILE  JULY76 

CALL  KANACF  ( I SUBH2 , NRSSH , SSHDT A , L SU BH2 , I X SUBH , L I XSSH 1 2 ) JULY76 

GO  TO  990  DS123 

DS123 

GROUP  III  SUBSTRATUM.  SET  GROUP  III  FLAG  DS123 

AGGREGATE  SUBSTRATA  DATA  SET  3 INTO  DATA  SET  6 (STRATA  LEVEL)  DS123 
EOS.  47  - 49  DS123 

390  TWAS3=  TWAS3  + TWAK  DS123 

HWAS3=  HWAS3  + HWAK  DS123 

XCT3S  = XCT3S  + CT3K  . DS123 

DS123 
ns  12  3 
DS123 

TEMPORARY  DEBUGGING  PRINTOUT  n‘^123 

990  CONTINUE 

c n$]23 

c US123 

RETURN  DS123 

END  ■ 0S123 
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p rrr 


1 


000001 

ooooo<e 

000003 

oooooo 

OOOOOb 

000006 

000007 

OOOOOB 

000009 

ooooto 
oooon 
0000  I <1 
000013 
000050 

oooorj 
000016 
OOOU  1 7 

ooooits 

0000  19 
OOOOPO 

oooo^l 

oono?2 

0000?3 
000020 
0000?i> 
000026 
000027 
00 Oo20 
000029 
000030 
000031 
000032 
000033 

noon  VI 

0000.3b 
000036 
000037 
000036 
000039 
OOOo'IO 
OOOO'll 
000002 
000 003 
OOOOOO 

oonoos 

000006 

000007 

0000 

000009 

0000*30 

nooo',1 

000032 

0000*33 

OOOOS4 

oono‘'*,i 

ooooso 

0000*,/ 

nooo''« 


c 

c 

c 


c 

c 


c 

c 


c 

c 


c 

c 

c 

c 

c; 

c 

c 

c 

c 

c 

c 

c 

c 

L 

c 

c 

c 

c 

c 

c 


siuiroutinf  osia  usie 

COMpUTfS  CLHA  AND  CLPRD  IN  DATA  SET  18  ON  THE  FINAL  ITFRATION, ' OSlfl  . 

DS18 

AKOUHENT  LIST  F(JR  FRROR  PROCESSING  ARGlST 

COMMON  /AI<r-LSl/  ARGLST 

1-  NLRnS  tNFATALf NPFKRS,NARG  fARG(lO)  . • AROI ST 

DlHlNSlfitl  I arc  (10)'  ARgLST 

EOUTVALFNCL  ( lARGfARG  ) • ARf.t  ST 

•AROLST 

DATA  UlOCK  FDR  CAS  CimULATIVf  FILE  CASCUM 

CAS  DATA  SETS  14 i JS,  16 » AND  17  CAbCUM 

common  /cascum/  ‘ CASruM 

1 rAScUri(32)T  HUFFR(S04)  LASClJM 

OIMr-NSiOM  1CASC(32),  OstT14(S2),  DS£TIS(?2),  0SET16(22)  C/SCoH 

1 tl.61  It /(2I1)  CASCUM 

EOUIValFNCE  ( ICASCiCASCUM  ) CASCUM 

EnUfVALfNCE  C DbEll 4 , OsE Tl S , OSE T 1 6 , DSET 1 7f C ASCUM ( 6)  ) CASCUM 

1 » ( S'-'AI  RS,SuAER2»SnArRRtSiJAERC»CASCUM(24)  ) CASCuM 

2 » ( SOHf  RS»S(JPt-H/tSf3MrRRf  SuPt,KC*CASrUM(?b)  ) CASCUM 

3 t ( St)YlRS,SJYI  R2iSQYFHRTSoyERL»CAbC0M(26)  ) ' ' CASCUM 

CASCUM 

PLAG6  and  counters  FOR  CAS  STHULAHIR  LASFLD 

COMMON  7CASM  0/  CAsFLO 

1 H fPPfLG  ,N!(W  ,imi  fUINOOM.lPL)  *IPP  ♦ PRO  A T F f NKEOS  CASH.O 

2 fNZToT  tN5tRAT,NYESSK,NSSHSK»NcAHSKfNRYFS  *NRS3H  *NRCAMS  CAJjFlG 

3 jENDc  tENnREf,*!.NDZON,  IRSTN  t ! R70NE  f IRRFC  (.ASPlO 

4 tlDSi  tLDS't  ♦IUS7  ,LDS8  fLDS9  fLDSIO  jlUSlt  .L0S12  fLDSl3  CASFLO 

5 »I0S14  ,LDS1S  flilSlA  .LDSW  . LHCOUN  . I.RUF  6 f t R TONE  , LRS  IK  CASftO 

ituroER  ppflG  •,  wiNunw  t ppuaie  casflg 

CASFlG 

statistical  INFURHAfTON  FuR  1.LH  STaTS 

COMMON  /STATS  / ,•  STATS 

1 TTfR  »nSFGTRTHCAHSR,NYt  ST,  , NHEC  ( 7)  t NC  ASCR « NC  ASU9  STATS 

tnuiVALCNCt  { NlflTER  ) STATs 

stats 

summary  Data  for  rc.poRTS  sumDta 

COMMON  /SUHdTa/  • SUMO r A 

I CVAfcPI,CVhPTA, SUPER  , C VPEP T rC VEPTP , CSUMR t 18 , 1 8)  SUMDtA 

. SUHDTA 

OS  18 

INPUT  data  ...  0518 

US  18 

NT  = ITER  = MtiNIF  i.«;<LO  ITFRATIUN  NUHUFR  USl8 

TPP  = PKFDICTION  POINT  INDEX  (INCLUDING  MIOHINOOKS)  USlfl 

SUAL'RC  = SUM  OH  SCUARFS  OF  AKFA  ERRORS  US  18 

SUPfRC  = SUM  OF  SQUARES  OF  PRODUCTION  ERRORS  . DSlfl 

OSFT) 7(2)  = THUt  Na  US18- 

Dsrri/(3)  = mean  estimated  ra  osin 

nsF;Ti7(4)  = mean  area  error  usia 

DSFTt7(6)  = TRUE  PRUOOCTIUN  US18 

05iTl/(7)  = MIAN  LSiTMATFD  PRODUCTIUN  USIH 

nsrriVfH)  - mean  produciiun  frrur  usi8 

■ ’ - USlM 

output  OUANTITIES  ...  . US18 

CMImROUIPP)  = OLWA  ' ' USl8 

rSUftlU  1‘J,  IPP)  = CLPHO  US  18 

US  18 

LOCAL  vARTAhU.3  ...  . USTfl 


d 

ilcp 
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0000S9 

c 

•'  FNT  = NT  = MONTE  CaKI  0 ITEKATION  (FL0ATIN6  POINT) 

PS  18 

000060 

c 

FHTJ  = NT  - t 

D?1R 

OOOOtl 

■ c 

VL.OC  = area  vakiancf  f.rror  for  country 

0818 

00006^ 

c 

vkPc  = PRouurnoN  variance  error  tor -country 

DsSlR 

000063 

c 

Y ? DIVISOR  TOR  XI  ANO  X2 , 

OS  18 

000064 

c,  ■ 

XI  = AHGU'n.NT  FOR  PCX)  FUNCTION 

0818 

001*065 

, c 

X2  = argu.'ilnj  For  pcx)  function  ■ 

Dsm 

000066 

c 

06  18 

00006’/ 

c 

OvSm 

000064 

c 

MJ.  1H2 

0818 

00006V 

FNT=  NT 

0614 

000070 

FNT1=  nT  - 1 

08  18 

000071 

VFAC=  ( SOAFRC  - (DSET17(4)<'  + ?)*FNT  )/  FNTl 

OS  18 

000072 

• 

AR0(1)=  4MVFAC 

OSin 

000073 

IAKr.(,?)=  16? 

0S14 

0000/4 

Y=  Y3U()(Vr  Ar,DSFU7(2) ) 

OS  18 

000075 

X)  = - ( r>?LTiy(i)  - 0.9-fl)jiETl7(?)  )/  Y 

OS  18 

000076 

X?8  (-()StT17(3)  - ,l.lM)8Eri7C2)  )/  Y 

OS  18 

00 007/ 

c 

Sl(t«E  a.WA  IN  CbUlSRCI  1*1PP) 

0518 

o'ooo/a 

CSUHRCll f IPP)=  ( P5UHCX1)  - PSU»(X2)  )»100.0 

US18 

000079  • 

c 

l)S  ! 8 

nOOyRO 

c 

HI,  163 

OS  18 

OOOOfll 

VfPr=  ( SOi'ERC  - (0vSETl7(4)*»2)*FNt  )/  FNTl 

OSlfl 

O00042 

ARO(i)=  'iMvrpc 

OS  1 8 

OOOOR3 

IAKi't?)e -tttt 

OS  18 

000084 

Y=  YbUn(vrpctDsFTr/(tt)) 

0518 

000085 

X5=  ( ijSt.Tl7(7)  - 0.9*OSETI7(6)  ) / Y 

OS  1 8 

000046 

X?=  ( (ir,LT17{7)  - 1,1»D5ET17I6)  )/  Y 

OS  18 

000047 

c 

riorf  rtPRO  IN  osuoR nSf  ipp) 

OS  1 8 

0 0 0.088 

CSUMt<(  IfM>)=  { PbUbfXl)  - PSU')(X2)  )-MOO.O 

OS  18 

000049 

c 

06  1 8 

000090 

900 

RFIURN 

OS  1 8 

000091 

END 

OS  18 

oo  DO  no.  ooo 


FURt IS  DS456 

SUBRUUTINE  DS456 

PROCESSES  DATA  SETS  4t  AND  6 AT  THE  STRATA  LEVEL 

CAS  CONTROL  CARO  INPUT.  DATA  AND  CONSTANTS 
COMMON  /CASCM  / 

1 AREACF,YCF  tPROCF  ,APRUTS(4,2)  ,PPRUTS(5f2)  ,YPRUTS(3,2) 

2 » AKEAPS,S2MAX  ,NHISTY,HH  ,TOPT  , AON  I T S , DI ST FF , B W I NO ( 4 ) 

3 ,WPKI0R(4)  tAPREP  ,IPRD(3»14)  , NPD ATE » PR U ATE { 14 ) 

INTEGER  HH,  TOPTt  A UN  I T$ , D I STF F , B W I NO , WPR I OR , APR EP , PRD AT E 

FLAGS  AND  COUNTERS  FOR  CAS  SIMULATOR 
COMMON  /CASFLG/ 

’1  H tPPFLG  tNRW  ,IBW  , WINDOW, IPD  , I PP  , PPDATE, NREGS 

2 tNZTUT  tNSTRAT,NYESSK,NSSHSK,NCAMSK,NRYES  tNRSSH  tNRCAMS 

3 ,ENDC  , ENOREG ,ENDZ0N, IRSTR  , I RZON E , I RRE G 

4 ,LDS1-  ,LDS4  ,LDS7  ,LDS8  ,LDS9  ,LDS10  rLDSll  ,LDS12  ,LDS13 

5 ,LDS14  ,LDS15  ,LDS16  ,LDS17  , LRCOU N , L RRE G , L RZ ONE, L RS TK 
INTEGER  PPFLG  , WINDOW  , PPDATE 

CAS  DATA  SETS  4.  5,  AND  6 (AT  STRATA  LEVEL) 

COMMON  /DSET4  / 

1 STRATA, TWASl  ,HWAS1  ,EWAS1  ,XM1JS  ,XCT1S  ,ANVS1 

2 ,TWAS2  ,HWAS2  ,EWAS2  ,XM2JS  ,XCT2S  ,ANVS2  ,T 

3 ,TWAS3 ,HWAS3 ,XCT3S 

4 ,XYS  , XESTYS ’,  EVVRS  , P2  I DPK , V IV 2S  ,VARS  , ANVARS 

5 ,FILL4(57) 

INTEGER  STRATA 

DIMENSION  DSET4(24),  DSET5(7)t  DSET6(3) 

EOUIVALENCE  ( 0SET4, STRATA  ),  ( DSET5,TWAS2  ),  ( DSET6,TWAS3  ) 

CAS  DATA  SET  7 (AT  ZONE  LEVEL.) 

COMMON  /DS6T7  / 

1 ZUNE  VHWAZ2  , EZ  , M 1 K2 KZ , AN AL V Z , NSTR A Z , HWAZ 1 ,EWAZ1  ,HWAZ3 

2 ,ESTVZ  ,HWAZ12 

3 ,M1K2CL{10)  ,EPWCL(10)  ,EPW2CL(10)  ,PKPICL(10) 

4 ,PK2CL(10)  ,PKCL(10)  ,SSD(10) 

INTEGER  ZONE 

REAL  M1K2KZ,  M1K2CL 
DIMENSION  DSET7(81) 

EQUIVALENCE  ( DSET7,Z0NE  ) 


DS456 

DS456 

DS456 

CASCM 

CASCM 

CASCM 

CASCM 

CASCM  • 

CASC(^1 

CASCM 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

CASFLG 

DSET4  ‘ 

DSET4 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

DSET4 

DSeT4 

DSET7 

DSET7 

JULY76 

JULY76 

JULY76 

JULY76 

vJULY76 

JULY76 

JULY76 

DSETT 
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C l)S6T7 

C CAS  DATA  SET  10  (STRATA  DATA  — FINAL  PASS)  • JUI.Y76. 

COMMON  /DSETLO/  ’ JULY76 

.1  HWAS  fTWAS  fEWAS  »AERRS  »AVARS  , 'i  PRODS , E PRODS  » PRE  RRS , PRVARS  JULY76 

2 rYS  tESTYS  ,YERRS  ,M1-JS  ,M2JS  ,CT1S  ,CT2S  ,CT3S  .,ANAVS  J0LY76 

3 jAMPKVStES  JULY76 

REAL  MIJS  f M2JS  JULY76 

DIMENSION-  DSETlO(20),  JULY76 

EQUIVALENCE  ( DSET10,HWAS  ) JULY76 

D SET  10 

CAS  DATA  SET  11  (ZONE  DATA  — FINAL  PASS)  . JULY76 

C(JMMON  /DSETll/  DSETll 

1  HWAZ  ,TWAZ  tEWAZ  ,AERRZ  rAVARZ  tTPRODZ ,EPRDDZ , PRERRZ » PRVARZ  DSETll 
4 ' 2 tTYZ  ,EYZ  ,YERRZ  ,M1Z  ,M2Z  tCTlZ  ,CT2Z  ,CT3Z  ,ANAVZ  DSETll 
' 3 .tANPRVZ  DSETll 

REAL  MIZ  , M2Z  DSETll 

DIMENSION  DSET1K19)  DSETll 

EQUIVALENCE  ( DSETlltHWAZ  ) DSETll 

C DSETll 

C FILE  DEFINITIONS  AMD  RECORD  LENGTHS  • FILES 

COMMON  /FILES  / FILES 

1 SEGID  /LSEG'iDtCROPW  ,LCROPW,  SUBHST,  LSUBH  , ACQUIS, LACQ  'FILES 

2 tCAMSF  ^LCAMSF,CAMERR,LCAMER  ,CASF  ,LCASF  , Y ESOU T , LY ESO  FILES 

3 ,SIGEXT,LSIGEX,YESERR,LYESER»SEGTRU,LSEGTR,CASDIS,LCASD  ' FILES 

4 , INP  fOUTP  ,TACO  ,LTACO  ,C ASDSF , LC A SDS  FILES 

INTEGER  SEGID  ,CRGPW  , SUBHST , ACQU IS , C AMSF  ,CAMERR,CASF  ,YESOUT  FILES 

1 ,SIGEXr,YESERR,SEGTRUtCASOlS,OUrP  ,TACQ  ,CAS0SF  FILES 

C FILES 

C INDEX  RECORD  FOR  CAS  INTERMEDIATE  DATA  SET  FILE  (CASDSF)  IXCDSF 

COM('^i((M  /IXCDSF/  IXCDSF 

1 IXCDSF ( 1 ) ,LIXCDS 

C IXCDSF 

C DEBUGGING  PRINT  FLAG  DS456 

• . COMMON  /DEHIJGF/  DEBUGF  ' . DS456 

C • DS456 

C DS456 

100  CONTINUE  DS4S6 

C WERE  THERE  ANY  GROUP  II  SEGMENTS  ACQUIRED  FOR  THIS  STRATUM  DS456 

IF  ( XM2JS  .NE.  0,0  ) GO  TO  480  DS436 

C NO.  RECLASSIFY  ALL  GROUP  II  SUBSTRATA  AS  GROUP  III  SUBSTRATA  DS456 

C BY  ADDING  DATA  SET  TO  DATA  SET  6,  THEN  ZEROING  OUT  DATA  SET  5 DS456 
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I 

TWAS3=  TWAS3  + TWAS2  US456 

HWAS3=  HWAS3  + HWAS2  0S456 

XCT3S  = XCT3S  + XCT2S  ' 0S456 

DO  470  1=1,7  JULY76 

DSET5{ I )=  0.0  DS456 

470  CONTINUE  DS456 

GO  TO  500'  DS456 

. C ‘ DS456 

C GENERATE  REST  OF.  DATA  SET  5 (EQNS.  33,36,40,  AND  39)  DS456 

480  EWAS2=  HWAS2*P2IDPK/XM2JS  ^ ' 05-^156 

ANVS2=  AMVS2/XM2JS  . ' DS456 

IF  { TORT  .NE.  0 .AMD.  XCT2S  .GT.  1.0  ) CALL  TSUB  DS456 

C . ■ DS456 

•C  WRITE  DATA  SETS  4,5,6  ON  INTERMEDIATE  FILE  DS456 

500  IRSTR=  IRSTR  +1  DS456 

NSTHAZ=  NSTRAZ  + 1 . DS456 

NSTRAT=  MSTRAT  + 1 DS456 

C MOVE  YS  and  ESTYS  FROM  DATA  DET  10  TO  DATA  SETS  4,5,6  DS456 

C BEFORE  WRITING  STRATA  DATA  ONTO  CAS  INTERMEDIATE  FILE.  US456 

XYS  = YS  DS456 

XESTYS=  ESTYS  DS456 

CALL  RANACF  ( CAS DSF , I RSTR , DSET4 , LC ASDS , I XCDSF , L I XCDS , 2 ) DS456 

C DS456 

C AGGREGATE  STRATA  DATA  SETS  4,5,6  UP  TO  DATA  SET  7 (ZONE. LEVEL)  DS456 

C ( EQS.  50-56,58,59,61,62,68,69  ) . DS456 

TWAZ=  TWAZ  + TWASl  + TWAS2  + TWAS3  US456 

IF  ( XMIJS  + XM2JS  .EQ.  0.0  ) GO  TCl  990  DS456 

M1K2KZ=  M1K2KZ  + XMIJS  + XM2JS  -DS456 

HWAZ1=  HWAZl  + HWASl  + HWAS2  DS456 

' EWAZ1=  EWAZl  + EWASl  + EWAS2  , DS456 

C DS456 

990  RETURN  JULY76 

END  DS456 
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FOR, IS  DS7 

SUBROUTINE  DS7  OS 7 

. 0S7 

PROCESSES  DATA  SET  7 AT  THE  ZONE  LEVEL.  ’ 0$7 

DS7 

ARGUMENT  LIST  FOR  ERROR  PROCESSING  ARGLST 

COMMON  . /ARGLST/  ARGLST 

1  NERRS  tNFATAL , NPFRRStNARG  ,ARG(10)  ARGLST 

DIMENSION-  lARG(lO)  , ARGLST 

EOUIVALENCE  ( lARGtARG  )'  ARGLST 

ARGLST 

CAS  CONTROL  CARD  INPUT  DATA  AND  CONSTANTS  CASCM 

COMMON  /CASCM  / CASCM 

1 AREACFtYCF  tPRDCF  tAPRl,JTS(4T2)  , PPRUTS  { 5 , 2 ) - ,YPRUTS(3t2)  CASCM 

2.  , AREAPS  ,S2MAX  tNHISTYtHH  ,T0PT  t AUN  I T S t D I S TF  F , BW  I NO  ( A- ) CASCM 

3 ,WPRIOR(4)  tAPREP  ,IPRD(3tl4)  , NP DAT E , PR DAT E ( 14 ) CASCM 

INTEGER  HH,  TOPTt  AON  I TS t D I S T F r , B W IND , W P R I OR » APR EP , PRDATE  CASCM 

CASCM 

FLAGS  AND  COUNTERS  FOR  CAS  SIMULATOR  CASFLG 

COMMON  /CASFLG/  . CASFLG 

1 H ,PPFLG  ,NBW  ,IBW  jWINDGWtIPO  ,IPP  , PP DA TE t NREGS  CASFLG 

2 ,NZTOT  tNSTRAT,NYES5K,NSSHSKtMCAMSK,NRYES  ,NRSSH  ,NRCAMS  CASFLG 

3 ,ENDC  rENDREGrENOZONr  IRSTR  , I R ZOIME  1 1 RR  EG  CASFLG 

4 tLDSl  ,»LDS4  ,LDS7  tLDSB  tLDS9  ,LDS10  ,LDS11  ADS12  tLPS13  CASFLG 

5 rLDS14  ,LDS3  5 ,LDS16  ,LDS17  , LR CO  UN , L RR EG  ,LRZ ONE ,LRSTR  CASFLG 

INTEGER  PPFLG  , WINDOW  , PPDATE  ' CASFLG 

C CASFLG 

C-  constant  QUANTITIES  FOR  LEM  PROGRAM  CONST 

COMMON  /CONST  / CONST 

I MTRMX  tMAXR  ,MAXZ  t IM XS E G , ENDF I L , I T SFG  CONST 

C CONST 

. COMMON/F ILESI/  pTFSl 

■ 1ISUBH2 ,LSUBH2,MXCLSS  FILESI 

C CAS  data  set  7 'AT  ZONE  LEVEL)  DSET7 

COMMON  /DSET7  / • 0SET7 

1 ZONE  ,HWAZ2  »EZ  t M 1 K2KZ , AN AL V Z , NSTR AZ , HW AZ 1 ,EWAZ1  ,HWAZ3  JULY76 

2 tESTVZ  ,HWAZ12  JULY76 

3 »M1K2CL(10)  tEPWCLUO)  tEPl^2CL(lO)  ,PKPICL(10)  JULY76 

4 ,PK2CL(10)  tPKCL(lO)  ,SS0{10)  JULY76 

INTEGER  ZONE  JULY76 

REAL  M1K2KZt  M1K2CL  JULY76 
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OIMENSIGiM  DSET7(81)  JULY76 

E(.)UI  VALENCE  ( [)SET7,ZGNE  ) DSET7 

C ■■  ■ , DSET7 

C CAS  DATA  SET  8 (AT  REGIGN  LEVEL)'  USET8 

COMMON  /DSET8  / . Di(ET8 

1 REGION, HWAR2  ,ER  , M I K2KR , ANAL VR , NZON ES , HWAR 1 ,EWAR1  ,ESTVR  JULY76 

2 ,M]M2ZR,FIU_8(71  ) JULY76 

INTEGER  REGION  JULY76 

REAL  M1K2KR  JULY76 

DIMENSION  DSET8(10)  JULY76 

EQUIVALENCE  ( DSET8, REGION  ) . DSET8 

C . DSET8 

C CAS  DATA  SET  11  (ZONE  DATA  — FINAL  PASS)  JULY76 

COMMON  /DSETll/  * DSETll 

1 HWAZ  rTWAZ  - ,EWAZ  ,AERRZ  ,AVARZ  , T PRODZ , EP ROD Z , PR ERRZ , PR VARZ  DSETll 

2 ,TYZ  ,EYZ  ,YERRZ  ,M1Z  ,M2Z  ,CT1Z  ,CT2Z  ,CT3Z  ,ANAVZ  DSETll 

3 tANPRVZ  DSETll 

REAL  MIZ  , M2Z  DSETll 

DIMENSION  nSETll(19)  DSETll 

EQUIVALENCE  ( DSETll, HWAZ  ) DSETll 

C , DSETll 

C CAS  DATA  SET  12  (REGION  DATA  — FINAL  PASS)  JULY76 

COMMON  /DSET12/  DSET12 

1 HWAR  ,TWAR  , EWAR  ,AERRR  , AVARR  , TPRUOR , E PRODR , PRE RRR , PRVARR  DSET12 

2 ,TYR  ,EYR  ,YERRR  ,M1R  ,M2R  ,CriR  ,CT2R  ,CT3R  ,ANAVR  DSET12 

3 , AMPKVR  DSET12 

REAL  NIR  , M2R  DSET12 

DIMENSION  DSET12(19)  DSET12 

E(OUIVALENCE  ( DSET12,HWAR  ) OSETI2 

C ‘ DSET12 

C FILE  DEFINITIONS  AND  RECORD  LENGTHS  FILES 

CUMMUN  /FILES  / | FILES 

1 SFGIO  ,LSEGID,CROPW  ,LCROPW , SUBHST ,LSUBH  , ACQUIS, LACQ  FILES 

2 ,CAMSF  ,LCAMSF ,CAMERR,LCAMER, CASF  ,LCASF  , YESOUT, L YESO  FILES 

3 ,siGEXT  ,lsigex,yeserr,l.yeser,segtru,lsegtr,casdi  s,lcasd  files 

4 ,INP  ,OUTP  ,TACQ  ,LTACQ  , C AS DS F , LC AS DS  FILES 

INTEGER  SEGID  ,CROPW  , Si)  BH  S f , ACQIJ I 5 , C AMS  F ,CAMERR,CASF  ,YESOUT  FILES 

1 , SIGEXT,YE5ERK, SEGTKU, CASDI S,OUTP  ,TACO  ,CASDSF  FILES 

c ' ■ files 

C INDEX  RECORD  FOR  CAS  INTERMEDIATE  DMA  SET  FILE  (CASDSF)  IXCDSF 

COMMON  /IXCDSF/  ' IXCDSF 
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1 IXCDSF ( 1) tLIXCDS 

■ C . IXCDSF 

C debugging  print  flag  ■ GS7 

CUMMUN  /DEBIJGF/  OEBUGF  DS7 

C . 0S7 


DUUI3LE  PRECISION  XGOPtZER 

DOUBLE  PRECISION  ArBrO,  XGO I t XG02 , XGQ 3 , X GOA , XG05 » X GQ6 

DATA  XGOP/2,ODO/,2ER/O.ODO/ 

> DS7 


LOCAL  VARIABLES  DS7 

A = REGRESSION  COEFFICIENT  USED  TO  CALCU.LAT6  S^^^«2  0S7 

B = REGRESSION  COEFFICIENT  USED  TO  CALCULATE  S=S'«2  DS7 

0 = DENOHINATOR  OF  B DS7 

SOSO  = S0--2  DS7 

DS7 

00  CONTINUE  DS7 

DS7 

• ■ DS7 

GENERATE  REST  OF  DATA  SET  7 (ZONE  LEVEL)  0S7 

' DS7 

IF  M1K2KZ  = 0,  NO  ACQUIRED  GROUP  I OR  GROUP  II  SEGMENTS  IN  ZONE.  DS7 
HWAZ2  = EZ  = ANALVZ  = HWAZl  = EWAZl  = SSO(CLASS)  = 0.0  J0LY76 

IF  ( M1K2KZ  .EQ.  0.0  ) GO  ID  780  JULY76 

DS7 

M1K2KZ  .GT.  0.  COMPUTE  EZ  (EO.  63)  DS7 

' IF  ( HWAZl  .NE.  0.0  ) EZ=  EWAZl/HWAZl  DS7 

IF  M1K2KZ  .LT.  2»  THEN  HWAZ2  = 0 AND  SSO( CLASS)  = 0 FOR  ALL  ' JULY76 
CLASSES  IN  ZONE  vJUl.Y76 

IF  { M1K2KZ  .LT.  2.0  ) GO  TO  780  JULY76 

DS7 

M1K2KZ  .GE,  2.  SET  HWAZ2  = HWAZl  (EG,  57)  JULY76 

740  HWAZ2=  HWAZl  DS7 

M1M2ZR=  1 L)S7 

DS7 

COMPUTE  S*'i<2  ( EOS.  64-67  ) .057 

! FUR  EACH  CLASS  IN  ZONE  JUI.Y76 

DO  770  ICL=1tMXCLSS  ' JULY76 

•■IF  ( MLK2CL(ICL)  .EO.  0.0  ) GO  TO  780  JULY76 

IF( M1K2CL ( ICL ) ,GT.  1.0)G0  TO  750 

C LESS  THAN  2 ACQUIRED  SEGMENTS  IN  CLASS,  JULY76 


C ON  THE  FIRST  MONTE  CARLO  ITERATION  PRINT  WARNING  AND  CONTINUE  JULY76 
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IAKG(1)=  ICL 

IAKG( ?)=  M1K2CL( ICL ) 

CALL  ERRMES  { 3HCAS , 3HDS 7 j 19 t 0 ) 

GU  TU  770 

C • 

730  IF  ( M1K2CL{ICL)  .LT.  H ) GO  TO  760  • 

NUMBER  OF  ACQUIRED  SEGMENTS  IN  CLASS  ,GE.  H, 

USE  REGRESSION  FORMULA 
XGOl  = M1K2CLI ICL) 

XG02  = PK2CL(ICL) 

XG03  = PKCL(ICL) 

Xb04  = PKPICL ( ICL ) 

XG05  = 6 PW CL (ICL) 

XGU6  = EPW2CL ( ICL  ) 

D = XG01*XG02  -XG03**2 
IF(D  .EO.  ZER)GO  TO  760 
B = (XGOl'^XGOA  - XGQ5*XG03)/D 
A = '(XG05  ~ B^’=XG03  ) /XGOI 

SOS(0  = ( XG06  - A^XGQS  - B’i'X GQ4  ) / ( XGG 1 - XGOP  ) 

GO  TO  765 

LESS  THAN  H BUT  MORE  THAN  1 ACQUIRED  SEGMENTS  IN  ZONE. 

USE  VARIANCE  FORMULA. 

760  SOSIO  = < EPW2CL(ICL)  - E P WCL  ( I CL  ) / M1K2CL(ICL)  ) /• 

1 ( M1K2CL(ICL)  - 1.0  ) 

765  SSO(ICL)  = AM  INI ( SOSO ,S2MAX  ) 

770  CONTINUE 

WRITE  DATA  SET  7 ONTO  INTERMEDIATE  FILE 
780  IRZUNE=  IKZONE  + 1 
NZTUT=  NZTOT  + 1 
NZUNES=  NZOMES  + 1 

CALL  RANACF  ( C ASDSF  , I RZON  E t DS  E T7  » LC  ASDS , I XCO  SF , L I XCD'S » 2 ) 

aggregate  ZONE  DATA  'SET  7 UP  TO  DATA  SET  8 (REGION  LEVEL) 
EONS.  70-76 T 78 T 79 
TWAR  = TWAR  + TWAZ 
HWAR2  = HV'JARZ  + HWAZ2 
M1K2KR=  M1K2KR  + M1K2KZ 


JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY76 


JULY76 

JULY76 

JULY76 

JULY76 

JULY76 

JULY 76 

JULY76 

JULY76 

JULY76 

JULY76 

OS  7 

DS7 

1'^  7 

DS7 
DS7 
DS7 
DS7 
DS7 
DS7  -• 
OS  7 
OS  7 
DS7 
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HWARl  = HWARl  + HWAZl 
EWARl  = EWARl  + EWAZl 

90  RETURN 
END 


US7 

DS7 

DS7 

DS7 

DS’7 
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oooool 
000002 
oooooi 
00 00 00 
OOOOOb 

oonooo 

000007 

000008 

oonoov 

OOOOiO 
OOOOl  1 
0000  12 

0 0 1)  0 I 3 
OOOOIO 
OOOOlb 
000018 

00001  V 
000018 
OOOOl  V 

0000r>0 

000021 

000022 

000023 

000020 

000025 

000026 

000027 

000026 

000029 

000030 

0U0U31 

000032 

000033 

000030 

000033 

000036 

00003/ 

000038 

000039 

OOOO'IO 

oooool 

000002 


f 1 


SUBHOIJTlMr  f-jECT  tNLlwES)  EJECT 

C REStOKFS  PAUE  and  PKINTS  the  page  header  fcJECT  ■ 

C EJECT 

C common  oI.OCK  DFPTNIITONS  EJlCT 

C Flit  OFFiNinONS  AnO  RECORD  LENGTHS  FILES 

COrtHOfJ  /FILLS  / . . • FILFS 

1 StGiO  tLSLGlDtCkOHw  ,LCKOPW  tSURHST  *LSOHH  “tACOUT  S»LACD  f iLFS 

2 tCAl'sE  fLCAM3f--iCAHERH,LCAHER,CASF  iLCASF  » YtSUtJT  tLYF.SO  FTLFS 

3 »r.ir;(-Xl,LSl(;LYfYtSt.RRTLYl  StR»StGTRUtL5tOTR»rASDI2tLCASO  F U.FS 

a ftNR  tUHlP  tTACU  ,ITaCU  fCASDSF .LCASDS  HIFS 

rNTFGlR  StOll)  »Cf?llRW  ,SU8HSt»AC0UIStCA^'5F  tCAHERRtCASF  tYESOUT  FILFS  • 
1 tSK.FxTtYESl RKfSEGTRUTrASOIStOUIR  tTACU  tCASDSF  FILFS 

C FILFS 

C I EM  control  card  IKRUT  DAIA  LFFiCM 

COHHOH  /II.HCH  / LFMCM 

1 TITlFUO)  iICASF  fLUNTRYtNlRIALtRS'T  art  tlPRlMtSTARlRtSIARTZ  Li  HCM 

2 iFIJOR  tEMC'/  tISTG  ,ICAHS  tlYFS  tIACU  1 1 CL  ASS  t ISt  XT  ilbCC'  LI  MOM 

3 fICAS?  tirAS3  tn'RCAH.I2l<Yl:3tIRRCAStICSFSGtICSF.CHtlCSF;SHfICStCE  LtHCM 

a f ICSf-;YM,ICSF5FiICSEAC,KSteol  tRSEtD2.RSEED3iRSEtDa.RSEeD.5»RSEED6  LFMCH 
5 tR6H-n/f  irst  ST  t ustco,  irSEYSf  ICStCUf  ICSKU)  LtMCM 

DlMF'NFinN  R6F.hn(7)  LFMCH 

DOOnLF  PRF.C1SI0N  r(SEFD  t RSEED 1 t RSEFU?  t RSEED3 1 RSt FO'l , HSEED5  LI  HCH' 

■ 1 tPS!  FCotRSEFI)?  LIMCM 

tool  VAeFNcE  ( RSFItOtRSFtni  ) LfMCH 

IF'IFGFr  RSTaRT.STaRTRtSTARTZiENDR  tfNDZ  LfMCH 

C LfMCH 

C PAf.h  t.ILr.I  CONTROL  PaHAHEIFHS  for  1 tM  PAofCM 

COMMON  /F'AGeI  11/  PACFCM 

1 NF’AgF  fNLlNt  tHXLlNt,NSTTL  tSOlUTunOJ  F-auFlM 

C pagfcm 

C LJLCl 

NUNLs  NLTNfS  * 2 ••  LJtCr 

M!’AGl=  NI’AGF  * 1 EJECT 

HRITI.  (nOTHfl)  flTLEt  TCASFt  NPAGE  LJhCT 

1 FORMAT  f IHltOXf 10A6tbXt23HLPP  SIMULATION  CAS£tl5f7H  PAUEtU  EJECT 

1 /)  EJECT 

IF  f NsTTL  .EO.  0 ) GO  TO -900  ' EJFCT 

, WRITE  (0UTPt2)'  SUBTTl  LJtCT 

Nl  1ML=  NLIliF  + 3 . EJECT 

2 FORMAT  (/25Xt 1CA6/)  . , EJECT 

900  RFTURM  FJeCT 

ENO  tJbCT 
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000001 

SUHROMtINF  fhrmc 

EPKMC 

000002 

c 

FWRoR  KOPEL  rClNTROl  ROUTINE  FOR-  THE  LtM  PROGRAl' 

ERRMC 

000003  ■ 

c 

TOR  EACH  MONTI  CARl  0 ITERATION  ERKHC  PROPERLY  INITIALUtS  THE 

EHRMC 

000004 

c 

RANDOM  NUHHER  StEOS  FOR  THE  TolLOhJNR  ERROR  SOURCES 

ERRMC 

00000b' 

•C  ■ ■ 

* classification  error  ncLASS) 

LPRHC 

000006 

c 

♦ SIf.NATURF  ^:xTE^tSI0>'l  ERROR  (ISEXT) 

LRRMC 

000007 

c 

* StOMTHl  CROP  CALFNOaR  FRROR  (ISCC) 

ERRMC 

OOOOOfi 

c 

♦ CAS  OROOP  n NON-EPOCH  YTARt  HISTOPICAL  PROPORTION  rtHEAT 

ERRMC 

000009 

c 

f 1CAS2) 

LRRMC 

000010 

c 

♦ CAS-OROOP  in  MOLTI-YLAR  PROPORTION  OF  hH£AT  (ICA63) 

ERRMC 

000011 

C ■" 

ERRMC 

0000)2 

c 

common  HI.OCK  DFflNlTTONS 

ERRMC 

000013 

c 

controi  Parameters  for  lem  program 

ClJTRL 

000014 

COMHOH  /CNTRl  / 

CNTRl 

0000) '3  . 

1 PRInTT ,NSrARTfSEFO( /> 

CPTRL 

00OO16 

IN’IEOTR  PRInTF 

tr-IKL 

OOOOl 7 

onuHLF  piu'cisioN  srto 

LHIRL 

000010  ' 

c 

CNTRL 

000019  ■ 

c 

LLM  control  card  INPUT  DATA 

LFMCM 

000020 

COMMON  /LLHCH  / 

LF  MCH 

000031 

1 TITl((10)  tICASF  .CUNTRYtNTRlALiRSTARTf 1PRINT,8TARIR»S7ARTZ 

l.F  MCM 

000022 

2 fENl'R  fENOZ  tlsTG  ,iCAflS  rlYFS  tlALO  1 1CL  ASS  f ISEXT  jISCC 

LFMCH 

000023 

3 tlCAS?  ‘tlCASi  tlPRCAM,  IPRYEStlPRCASrlrSPSOTlLSECHf ICSFSHfICStCE 

LIKCII 

000024 

4 tICSf  YM,ir5FSFncSLAC,RSEEUl  fRSFtn2fRSLF05fRSFEr)4,RSEEO‘5tt;SEEI)6 

L!  MCM 

•oono2b 

3 »RSFH)7TirsE5T,  JCSl  CO,  ICSF.YS  * ICSECOt  ICStCO 

LFMCH 

000026 

DiHFHSiON  RSEEO<7)  ' 

LI  HCM 

00002/ 

DOUliLT  PRICISION  RSEpD  * RSEt  0 1 1 RSEED2  » RSEE03 1 RSt  F04  r RSFE  Ob 

1 FlICM 

000020 

1 tPSf  ( i)».,RStl'I>7 

1 1 Ht'H 

00002V 

EOUI/AulNrE  ( RSlLOjRSFLin  ) 

LF  MCH 

000050 

INTFGFR  RSTARTfSTARlRfSlART/TENDfl  tTNOZ 

LF  HCM 

000051 

c 

L!  MCh 

000052 

c 

LKRMC 

000055  j 

c 

inputs  ...  TCAHSt . IfLASSt  1SEXT»  I5CC«  ICAS?»  lCAS3f  AND  RSEEOLKRMC 

000054 

c 

EHRMC 

000  0 Vj 

c 

OUTPUTS  ...  SLLO 

ERRMC 

0000  56 

c 

E RRMC 

OilOo  57 

c 

IINKAOI'  ...  CAl  L tRRMC 

LI'RMC 

00O05U 

c 

ERRMC  IS  CALLED  FROM  THE  LEM  DRIVER 

C.RRMC 

OOOy59 

c 

. 

F.I-'RMC 

OOOO'IO 

LRRMC 

000041 

c 

5 

EF-'RMC 

000042 

c 

* , 

ERR'H; 

0000 4 3 

c 

t 

ERRMC 

000044 

c 

test  the  cams  option,  it  KAHS  .NE.  0,  ALL  3 cams  errors  are 

E!<RMC 

00004b 

c 

CONSTANT  and  CAMS  Hll  L SF  CaLLEdIunly  ONTE. 

1 RRMC 

0 0 0 0 4 6 

c 

IT  ICAPS  = Of  IHIN  IN  OtNtRAL  EACH  UP  TliF  CAMS  ERRORS  HAY  HE 

EFiRMC 

000047 

c 

VARIED  OR  held  CON’sT'aNT  INDEPENDENTLY, 

ERRMC 

000040 

c 

EFFRMC 

000049 

IF  ( IcAHS  ,NF.  0 ) GO ' TO  200 

ERRMC 

OUOO'iO 

c 

ICAmS  = 0.  VARY  CAMS  ERRORS  CIR  HOLD  THEM  CONSTANT  AS  SPECIFIED 

ERRMC 

OOOOM 

c 

HY  iHt  PARAflEITRS  ICLASSf  ISTXT*  AND  ISCC 

1 RR.MC 

O0()0''2 

IF  ( IclASS  .10.  1 ) SFLt)(2)=  RSEED12) 

ER’RMC 

000055 

IF.  ( IsTXT  .EO.  1 ) SKU)(i)=  PSFtDl5) 

ERRMC 

000o')4 

IF  C ISCC  ,FO,  1 ) SFLD(4)=  RSEEDC4). 

ERR”C 

OflOobb 

c 

EfFRML 

OOUOS6 

200 

IF  (■  TCAS?  .EO,  1 ) SFED(hJ=  fiSEEDlA)' 

EFFnmc 

000457 

IF  f ICAS5-  .EH.  1 ) SFL017;=  RSFUU7) 

El'lv'lc 

OOOObO 

.900 

RFTURN 

ERRMC 
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000001 
000002 
000003 
000000 
ooooos 
000006 
00000/ 
000006 
000009 
00001 0 
000011 
000012 
000013 
0 0 0 0 1 0 
000015 
000016 
OOOOl  t 
000016 
000019 
0O0O20 
000021 
000022 
000023 
00O02'4 
000025 
000026 
00002/ 
000028 
000029 
0U0030 
00  00  U 
000032 
000033 
000034 
000035 
000036 
00003/ 
000030 
000039 
OOOOOl) 
OOOOO  I 
000002 
000003 
000004 
000005 
000006 
000007 
00000/3 
000009 
O00050 
0000^1 
0 V 0 0 '■>  2 
000053 
oonoso 
000055 
000056 
000O'-7 
oimoMi 


subroutine  F1<RHES  (PRnG.SUBRtICODF?LEVEU  tRRHfcS 

C CONTROLS  THE  PRINTlNr:  OF  ALL  ERROR  MESSAGES  FOR  LEH.  tRRMES 

G ■ ERRMES 

C TNPijT  parameters  ...  ERRMES 

'c  prog  = suaPRObfuH  wame.  in  a6  format  (e.g,  3hlehiohcam5»  etc.)  '■  ERRHeS 

C RUPR  = SUEROUTIRP  name  JN  A6  format  CE.G.  5HINPUT)  ERRMES 

C ILOurs  ERROR  LOi;E  ' t^RMES 

L LEVel=  ERROR  SEVERITY  LEVEL  (s  0 FOR  NONFATALt  * 1 F'OR  FATAL)  ERRMES 

C . EPRMt^S 

C,  ' ERRMFS 

c ■ Parameters  ro  be  printfu  as  part  of  frrur  message  are  passed  errmf.s 

C IN  THt  ARRAY  ARG  IN  /ARGLST/  ERRHES 

C ■ ERRMES 

C common  block  GF.F'JUTIIONS  errmcs 

C ARGuMENI,  list  for  frrur  PROCrSSIKG  ARot  !>T 

COMMON  /AHClST/  ■ ARM  ST 

1 NH?rS  ,N/-aTaI  vNPCRRS.NARG  tARGnO)  ARgI  ST 

DIMENSION  lA^'CClO)  ARGIST 

EnuIVALENCE  ( lARGtARG  ) AK’Gt  ST 

C • APGIST 

C rONsTA/il  OUAMTITUS  FOR  LEH  PROGRAM  CliNSf 

common  /const  / CONST 

1 NTRrK-.HAXR  fMAXZ  ,IHXSEG,EnOFIL. JTSFG  ■ CONST 

C lonsi 

C ■ FUf  DFFlNlnOMS  AND  RCCOliO  LENGTHS  FIlF'S 

COMMON  /FILES  / fiefs 

1 SEClO  ,LSF  Gin,CROPR  , LCROPH  ♦ SUBHS  T . LSUOH  » ACOU  IS  r L AC!)  flLFS 

2 .CAMsr  ,lfAM6F,CAHtPH,LCAMER.CASF  .LCASF'  t Y t S OU I . L Y t SO  (iLFS 

3 iSlr-eXt  ,LSlGtXiYtSLRR.LYESEHiSEG1ROiLSEGIRiCASDIS»LCASU  F U FS 

n iINP  i!)UlP  »TACO  ,LTaCO  .iCASOSF.LFASOS  FIt.FS 

INTK.fR  SlCjl)  tCRUl’H  rSUloiS  I f Ar;iJUISf(A‘iSF  ,CAN!l<RtCASF  lYFSOUI  Fll.Tb 

1 ♦SIGFxT»YE3ER-KSrGTHM,cASUlSt0iiTP  »TACO  fCASOSF  • FiLFs 

C FILFS 

C ■ LRRMtS 

C local  VAR  I Abus  ERRMeS 

C IKES  = ERROR  MESSAGE  CoOF.  ERh‘<f  S 

C blank  = 3H  = I ORK  OF  HLANKS  USED  TO  FILL  PARI  OF  ERROR  MESSAGE.  ERR.^ES 

C NONFTLs  3HNON  = PART  OF  ERROR  MESSAGE  tl-’R'-tS 

C (DISI INGOISHlS  F.ETwFEN  NOHFATAL  AMD  fatal  ERRORS)  ERRMES 

C ERRLVI  = UI.AMK  OR  NONFTL  (USED  TO  KILL  PART  OF  ERROR  FlESSAGt)''’  EI-RMeS 

C ERRHES 

RFAl  nONFTL  . FRKMF.S 

G ERRKES 

DATA  BLANKtNONFTL  ERRm^S 

1 / IH  t3MN0f.  / ERRMtS 

C . tRRMLS 

C LlMhAGF  ...  CALL  ERRmLS  ( PROG » SUBR . I CUBE . LEVEL)  ERRMtS 

c frrmfs  IS  callfd  From  leh,  input » inpchk  irkhls 

G . EPRMES 

c subroutines  used  ...  inperr  LRrHFS 

c LI-RMtS 

c . . ' tRRMtS 

IHESa  irUDE  , IRRMtS 

IF  ( I Mis  .FU,  99  ) GO  TO  990  ERRHtS 

C FRRMtS 

IF  ,(  U;VfL  .NE.  0 ) GO  TO  20  ' tr-RHES 

C NONfATAL  error  ■ El’RMFS 
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0000‘^v 

EKKlVIa  NONFTL 

LRRHES 

OOOOAO 

N£KRS=  MERHS  + 1 

ERRMES 

OOOOM 

GO  TO  3O 

fcPRMt'S 

OOOOh(i 

c 

fatal  FKRoR 

FPRMtS 

000063 

?0' 

ERKI  VI  = BL AMK 

ERKMf.S 

00006« 

NKATAls  NFATAl  + t 

ERRMES 

0 00 065 

c 

ERRMES 

000066 

50 

CALI  PAf.tR  (6) 

LRRMtS 

00006V 

WRirt  (nUTPilOyO)  ERRtVL»PR0r.»SUI3R»lM£.S 

EPRI'ES 

00006(3 

looo 

POKfiAT  (//  6H  »T9**tA3t?6HFA1 AL  ERROR  IN  SUPPROGRAH  »Ato» 

ERRMES 

000069 

I I'ltit  SUljf/UlIT  INF.  »A6iliH  ERROR  COOF  tHt/H 

1 RRMF  S 

000070 

C 

tRRHLS 

000071 

c’ 

TEST  HiR  CALLING  SimpROGRAH/ROBTINE  AND  CALL  PROPER  L0F(ER  LEVELERRMES 

00007.3 

c 

ROUtINF  TO  HRINl  ERROR  MESSAGE 

fc  RRMt  S 

000073  . 

IF  ( SU13R  .FU.  ‘ililNPUT  7 GO  TO  150 

H-RMES 

000079 

IF  ( SljBR  .RE.  6MINPCHK  ) GO  10  ?00 

ERK'iES 

000075 

c 

FRRriR  OE.TECIE'U  IN  |,  E M INPU1  PROCESSOR 

lprmls 

000076 

150 

CALI  InPH/R  (IHFS) 

EPRI'ES 

000077 

GO  TO  yOO 

ERR’.'tS 

0000/(3 

• c 

IF  { SUBR  .Nt.  6HCAMSIN  ) GO  1 0 300 

ERRMES 

000079 

200 

ERRMES 

noooKO 

C 

■ 

tPRMt,S 

0000(U 

C 

FRPOf^  DETECTEO  IN  CAMS  CONTROL  CARO  DATA 

ERRMES 

000063 

CALL  fAMLnS  (IMFS) 

LRRf-'ES 

0000/33 

GO  TO  9OO 

EP'kMES 

0000(3  9 

c 

LPRMFS 

000065 

300 

IF  ( SOUR  .NE,  5HCASIN  ,)  GO  TO  900 

tPKMtS 

0000/36 

IF  ( TfiFS  ,GT.  17  ) GO  TO  150 

ERRMhS 

OOOO/'V 

c 

ERRMES 

0000P(3 

c 

FRR()R  OETtCTFD  IN  CAS  CONTROL  CARO  DAIA 

ERRMES 

0000/39 

CALL  CaSERI  (IHFS) 

ERRMES 

000090 

GO  TO  9OO 

ERRMES 

000091 

c 

EPh.MF.S 

0 0 0 0 9 i 

(100 

NPERRSr  MPERK5  + 1 

LPRMt  S 

000093 

IF  C PrDO  .he.  9HCAHS  ) ’ GO  70  500 

LRRME  S 

flono'19 

c 

1 

ERRMES 

000095 

c 

FRRoR  DEThC/rO  IN  rAKjS  module 

ERRMtS 

000096 

CALI  rANFR2  (IMFS) 

ERRMES 

000(397 

GO  TO  VOO  ' . 

ERRMES 

00009/3 

c 

t HR.MES 

000099 

500 

IF  ( PpOG  .ME.  3UYES  ) GO  TO  600 

ERRMf.S 

000  1 no 

c 

} 

LRRMtS 

000101 

CALI  Pager  (3) 

ERRHf  S 

000102 

c 

FKRoP  detected  IN  module  yes. 

ERRMES 

000103 

Cl/3  TO  (510,520),  I Mrs 

LRrME  S 

000109 

510 

WRITE  (f'UTP,92n 

ERRi'tS 

000105 

9?1 

FORMAT  (3'62HoY£S  INPUT  FILE'  (YESERR)  - BEGINNING  REGION  AND  ZONE 

nlrrheS 

OOOl 06 

!0I  FU|i,\n  ) 

ERRM(  S 

00010/ 

GO  TU  9OO 

EPRMtS 

OOOlOO 

c 

ERRMtS 

000109 

520 

WRITE  (0UTP,922)  ■ ’ 

ERRMES 

OOn  1 1 0 

9^? 

F-OKMAT  (/'SVHoYtS  INPUT  FILE  (YESERR)  - ENDING  REGION  AND  ZONE  NOT 

ERRME  S 

OOOl  1 1 

IFOUlil)  ) 

1 R«<Mi  S 

000112 

C 

LRRMtS 

OOOJ  1 3 

600 

IF  ( PrOG  ,NE.  3HCAS  ) GO  TO  /OO 

LRRHES 

000119 

c 

1 CRMtS 

000115 

c 

FUR’dR  oninro  in  cas  simulator  muduie 

lrrmls 

OOOl  16 

CALI  PASLR2  (lnr.5) 

LRRMES 

0130  1 1 / 

c;()  .TO  90(3 

1 RRMt 3 

0 0 0 1 1 /s 

c 

LRR/'tS 
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000119 

700  IF  ( F|<OG  ,Nt.  3HS7G  ) UO  TO  900 

bPPHtS 

000120 

CALL  StGLRK  (IMH6) 

tPH'^ES 

0001?! 

C 

tRRMLS 

000122 

900  KfTimN  . 

bPK'^tS 

'0001?3 

900  CALL 'l>Af:tFf  (3) 

LPRHbS 

OOO 1?0 

WRlTh  (CHJTPflOon 

LPRHb.S 

OOOl?'? 

■ tool.  HOKMAT  (//OSH  JOO  TEiIhInATEO  IN  ERHHES  DUE  TO  FATAL  LRHORS  ) 

tPRMLS 

000126  ■ 

CALL  HRAPUP 

LRRHtS 

000127 

STOP 

LRRMUS 

000126 

too 

bPRMbS 
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FZUtUf  1,760428,  f»2^43 


, 1 


000001 

SltliPOlJTlNF  FZDL'KIDATFf  TOUT)  ' 

FZULU 

000002 

c 

'000.003 

c 

FZULU 

oooooo 

c.Kouniie  FztiLu 

FZULU 

000006 

• t: 

FZULU 

000006 

c 

PURPOSE  TO  CONVERT  ZULU  DATE  TO  YEAR  MONTH  AND  DAY  F7UIU 

000007 

c. 

1 ZUI  U 

ooooou 

c 

linkage  call  F7ULU  ( T 0 AT E , T OUT) 

, • FZEUu 

oooono 

c 

inATt,  OINAHY  INTfeGt'!  ZULU  OATE  FZULU 

000 010 

c 

inUT,  CaUPNOEP  OATEiOinFNSlON  3 FUR  iNTfcfitR  1 7Ut  U 

OOOOl  1 

c 

YFAR,  month  ANU  UAY  Hr.SPtCTIVFLV  FZUlU 

000012 

c 

FZULU 

000013 

' c 

ROUTINES  CaLLFD  NONF 

FZUI  U 

000014 

c 

F7U1  U 

000015 

■ - c 

LOCAL  VARIIRLFS: 

FZULU 

000016 

c 

■ 

FZULU 

OOOOl  / 

c 

IDAYS  VFCTOR  CONTAINING  NO.,  DAYS  Of  YFAH  ON  FZUl.U 

000018 

c 

LAST  IJAY  Of 

MONTHS  0 ThROMGH  12  FOR  NORMA!  FZULU 

000019  • 

b 

YFAR  FOLLOWED  (iY  13  MONTHS  OF  LEAP  YEAR  F7UI.U 

000020 

c 

F zu:  u 

oooo?l 

c 

NLtAPt  NO.  OF  LEAP 

YFARS  STNCE  1900  TO  6PEC1F1FD  FZlItU 

000022 

c 

OATS 

FZulU 

000023 

c 

NFLGt  SUliSCRIPT  INTO  lOAYS  VECTOR  f ZULU 

000024 

c 

STaH1  = 1,  NOT  LTAP  year  F 70l  U 

000025 

c 

STAf?|  = 14,  LFAP  year  F7UIU 

00002O 

c 

JOAY,  JULIAN  PAY 

OF  YEAR  , . F7UIU 

000027 

c 

If  LOCAL  USE 

FZUI  U 

000028 

c 

COMMENTS  NONF 

FZULU 

000029 

000030 

OIKEMFlON  I OUT  (4) 

F ZULU 

000031 

DiHFNt.lON  ir>AYS(2AO 

FZUI  U 

000032 

DATA  ToAYS/O, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 354.365,  • FzulU 

000033 

t 4,31,60,-71,121,152, 182,213,249,274.305.355,366/  F 7ul  U 

0000  34 

lOATl  a lOATE  + 18263 

FZULU 

00  0 0.35  , 

DO  5 Irl.3 

FZULU 

000036 

lOU'TU)  = 0 

. FZUlU 

0000  W 

5 CONTINUE 

. ' • FZULU 

OOC03U 

c 

find  no.  LFAP  YEARS  SINCE  1900  AND  GFT  CURRENT  YEAR  F7UI.U 

000039 

NLEAPr  (10O5+I0a7(:)/19M 

FZULU 

000040 

lOUT(l)  = (iDAIE-NLf AP; Z36S 

00004  1 

c 

SEE  IF  current  year  ISLEAP  YEAR-SET  NfLGal  OR  14  F'ZUl  U 

000042 

l=inUT(l)/4 

000043 

I = l»« 

FZUI  U 

000044 

000045 

NFLO=l 

IFdOUTin  - 1)10,10,20 

FZUlU 

000046 

10 

Ml  LGat/j 

FZULU 

00004/ 

c 

JUlIAN  DAY  = ZULU  DAY-NU 

YrARS»i65-N0,LEAP  YEARS  FZULU 

000048 

20  JDAVaioAIF-(lOUT(  1 )'»365)“NUEAP  + 1 

000049 

c 

get  day; month  from  tahle 

SFaRCH  FZUtU 

OOOO'iO 

c 

FZULU 

OOOOM 

30 

IF  (.IDAY-IDAYSINFLG))  50,50,40 

IZUIU 

000052 

4 0 

I(iUT(2)rI0UT(2)  + l 

FZULU 

00O0S3 

NFLt'.  = MFl  Ctl 

FZUt  U 

000054 

GOTO  3o 

FZUI  U 

000055 

50 

NFL<;=Nf!  G-1 

FZULU 

000056 

I0UT(3)aJ0AY-TDAYS(NF| G) 

FZut  U 

000057 

RETURN 

FZul  U 

000050 

END 

FZUI  U 

«NfcW 
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FUk,IS  getys 

SUBROUTINE  GETYS  GETYS 

READS  strata  YIELD  DATA  FROM  YESOUT  FILE  AND  OBTAINS  THE  GETYS 

PROPER  VALUE  OF  ESTIMATED  YIELD  FOR  THE  CURRENT  BIOWINDOW  GETYS 

UK  PREDICTION  DATE.  - GETYS 

GETYS 

ARGUMENT  LIST  FOR  ERROR  PROCESSING  ARGLST 

COMMON  /ARGLST/  ARGLST 

1 MERKS  ,MFATAL fMPRRRStNARG  ,ARG(10)  ARGLST 

DIMENSION  lARG(lO)  ARGLST 

EUUIVALENCE  ( 1ARG,ARG  i . ARGLST 

. • ARGLST 

FLAGS  AMD  COUNTERS  FOR  CAS  SIMULATOR  ' CASFLG 

COMMON  /CASFLG/  CASFLG 

.1  H ,PPFLG  ,NBW  ,IBW  , WINDOW, IPD  ,IPP  , PPDAT E , NRE GS  CASFLG 

2 ,NZTOT  ,NSTRAT,NYESSK,NSSHSK,NCAMSK,NRYES  ,NRSSH  ,NRCAMS  CASFLG 

. 3 ,ENI)C;  ,EMDREG,ENDZON,  IRSTR  , I RZON  E , I RREG  CASFLG 

4 ,LDS1  ,LDS4  ,LDS7  ,LDS8  ,LDS9  ,LDS10  ,LDS1-1  ,LDSI2  ,LDS13  CASFLG 

5 ,LDS14  ,LDS15  ,LDS16  ,’LDS17  , L RCOUN , LRRE G , LRZONE,  LRSTR  CASFLG 

INTEGER  PPFLG  , WINDOW  , PPDATE  CASFLG 

CASFLG 

CONTROL  PARAMETERS  FOR  LEM  PROGRAM  CNPRL 

COMMON  /CMTKL  / CNTRL 

1 PKINTF ,MSTART,5EED(7)  ' CNTRL 

. INTEGER  Pk'INTF  CNTRL 

DOUBLE  PRECISION  SEED  CNTRL 

CNTRL 

CONSTANT  (OIJANTITIES  FOR  LEM  PROGRAM  CONST 

COMMON  /CONST  / CONST 

1 NTRMX  ,MAXR  ,MAXZ  , I MX SEG , ENDF IL , I T SFG  CONST 

C CONST 

C CAS  DATA  SETS  4,  5,  AND  6 (AT  STRATA  LEVEL)  DSET4 

COMMON  /DSET4  / I DSET4 

1 STRATA, TWASl  ,HWASl  ,EWAS1  ,XM1JS  ,XCT1S  ,ANVS1  JULY76 

2 ,TWAS2  ,HWAS2  ,EWAS2  ,XM2JS  , XCT2S  ,ANVS2  ,T  JULY76 

3 ,TWAS3,HWAS3,XCT3S 

4 ,XYS  ,XESTYS,EVYRS  ' , P2IDPK, V1V2S  ,VARS  , ANVARS  JULY76 

5 ,FILL4(571 

INTEGER  STRATA  JULY76 

.DIMENSION  DSET4(24),  DSET5(7),  DSET6(3)  JULY76 

EOUIVALENCE  ( DSET4, STRATA  ),  ( DSET5,TWAS2  ),  { DSET6,TWAS3  ) DSET4 
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c DSET4 

C CAS  DATA  SET  7 (AT  ZONE  LEVEL)  DSET7 

COMMON  /DSET7  / ‘ DSET7 

1 ZONE  ,HWAZ2  ,EZ  , HIK  2K  Z . AN  ALVZ  r N STRAZ  » H WAZ 1 tEWAZI  »HWAZ3  s)ULY76 

2 »ESTVZ  ,HWAZ12  - JUlY76 

3 ,M1K2CL{10)  ,EPWCL(10)  ,EPW2CL(10)  ,PKPICL(10)  JULY76 

A ,PK2CL(i6)  PKCL(IO)  »SS0(10)  JULY76 

INTEGER  ZONE  JULY76 

REAL  M1K2KZ,  M1K2CL  vJULY76 

DIMENSIfDN.  OSET7(81)  JULY76 

EQUIVALENCE  ( 0SET7,ZQNE  ) . USET7 

C DSET7 

,C  CAS  DATA  SET  8 (AT  REGION  LEVEL)  DSET8 

COMMON  /OSET8  / .I0S6T8 

1 REGION, HWAK2  , ER  , M 1 K2KR , ANAL V R , NZON ES , HWAR 1 ,EWAR1  ,ESTVR  JULY76 

2 ,M1M2ZR,FILL8(71  ) JULY76 

INTEGER  REGION  JULY76 

REAL  MLK2KR  ‘ JULY76 

DIMENSION  DSFT8(10)  JULY76 

E(JUIVALENCE  ( DSET8tREGI0N  ) - DSET8 

C • OSET8 

C CAS  DATA  SET  10  (STRATA  DATA  — FINAL  PASS)  JULY76 

CUMMIJN  /DSETIO/  JULY76 

1 HWAS  rTWAS  ,EWAS  ,AERRS  , AVARS  , T PRODS , E PRODS , PR  ERRS , PRVARS  JULY76 

2 jYS  ,e’STYS  ,YERRS  ,M1JS  ,M2JS  ,CT1S  ,CT2S  ,CT3S  ,ANAVS  JULY76 

3 rANPRVSrES  JULY76 

REAL  MlJS  , M2JS  JULY76 

DIMENSION  DSET10(20)  JULY76 

EIOUIVALENCE  ( OSETIOtHWAS  ) . JULY76 

C DSETIO 

C FILE  DEFINITIONS  AND  RECORD  LENGTHS  FILES 

COMMON  /FILES  / FILES 

1 SEGID  ,LSEGID,CRnPW  , LCROPW , SUBHS  T , L SlJHH  , ACQUIS, LACO  FILES 

2 tCAMSF  ,LCAMSF,CAMERR,LCAMER rCASF  ,LCASF  ,YESOUV ,LYESO  FILES 

3 ,SIGEXT,LSIGEX,YESERKtLYESER, SEGTRU,LSEGTR,CASDIS,LCASD  FILES 

4 ,inp  tOUTP  ,tacq  ,ltaco  ,c asosf ,lcasds  files 

INTEGER  SEGID  ,CROPW  , SlJBHST  , ACOU  IS  , CAMSF  ,CAMERR,CASF  ,YESOUT  FILES 

1 ,S  IGEXT ,YESERR,SEGTRU,CASDISTnUTP  ,TACO  ,CASDSF  FILES 

c files 

C SUBSTRATA  HISTORICAL  DATA  FROM  SUBHST  FILE  . SSHDTA 

COMMON  /SSHDTA/  SSHDTA 
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1 CUUN2  ,IREG2  , I Z0NE2  t I STR  A2t  I SU  B.S  2 , NSEG  tlDSEG  ,GRPND  ,HISTPW  SSHDTA 


2 ,AREAK  tPWK  tMAGR  ,NA  t DE LT PW , DEL TPM t C V 1 ,CV2  »CV3  SSHDTA 

3 ,CV4  , VMIJLTK»CLASS(  18  ) ,MXK,  RDSSH  JULY76 

INTEGER  GRPMO  , CLASS  , RDSSH  JULY76 

DIMENSION  SSHnTA(39)  ' JULY76 

EQUIVALENCE  ( SSHDTAt  COUM2  ) ' SSHDTA 

C ■ SSHDTA 

,C  STATISTICAL  INFORMATION  FOR  LEM  STATS 

COMMON  /STATS  / ■ STATS 

' 1 ITER  ,N$EGTR,NCAMSRtNYESR  ,NREC{ 7 ) tNCASCR »NC ASDR  STATS 

EQUIVALENCE  ( NT, ITER  ) . STATS 

C STATS 

C YIELD  DATA  FROM  YRSOUT  FILE  YESDTA 

COMMON  /YESDTA/  YESDTA 

1 YSTR  ,IZPRDD(6)  • ,YSCI(6)  ,VSYCI(6)  YESDTA 

2 tRDYES  tNYESPP  ’ YESDTA 

INTEGER-  RDYES  YESDTA 

C YESDTA 

C DEBUGGING  PRINT  FLAG  GETYS 

COMMON  /DEBUGF/  .OEBUGF  G£  lYS 

GETYS 
GE  lYS 

• READ  STRATA  YIELD  DATA  FROM  YESOUT  FILE  GJEIYS 

NRYES=  NRYES  + 1 - GETYS 

READ  (YESOUT)  YCOUN , R EG  I ON , ZON E , STR ATA » YSTR  GETYS 

1 » ( IZPRDD(  I)  tYSCI  { I ) tVSYCI ( I)  , I = 1t6  ) GETYS 

IF  { YCdUN  .EO,  EMDFIL  ) GO  TO  999  ■ GETYS 

GETYS 

UN  THE  FIRST  ITERATION  OF  THIS  RUNt  CHECK  FOR  CONSISTENCY  GETYS 

BETWEEN  YESOUT  AND  SUBHST  FILES.  GETYS 

IF  ( NT  .GT.  NSTART  ) GO  TO  110  GETYS 

IF  { NSTRAT  .EQ.  0 ) GO  TO  110  G'=tyS 

IF  ( YCOUN  .ECO.  EMDFIL  ) GO  TO  999  GE  f'YS 

IF  { REGION  .NE.  IPFG2  ) GO  TO  999  GETYS 

IF  ( ZONE  .NE.  IZ0NE2  ) GO  TO  999  GETYS 

IF  ( STRATA  .ME.  ISTRA2  > GO  TO  999  GETYS 

C GETYS 

110  YS=  YSTR  ■ GETYS 

IF  ( PPFLG  ’.NE.  0 ) GO  TO  200  GETYS 

C GETYS 

C find  last  nonzero  YIELD  DATE  FOR  THIS  STRATA  GETYS 
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NYESHH=  6 GETYS 

DO  120  I=l»6  , GETYS 

IF  ( I2PRDD (NYESPP ) .GT-'O  ) GO  TO  130  GETYS 

120  NYESPP=  NYESPP  - 1 GETYS 

C , » GETYS 

C ALL  YIELD  DATES  AKE  ZERO  FOR  THIS  STRATA  GETYS 

CALL  EKRMES'  (3HCASt6HCASER2t7, 1 ) GETYS 

YSTR=  -1.0  GETYS 

. GO  TO  900  GETYS 

GE  I'YS 

PICK  UP  LAST  VALUE  OF  ESTIMATED  YIELD  AND  YI.ECD  VARIANCE  FOR  GETYS 
BIOWINDOW  (I8W)  GETYS 

130  ESTYS=  YSCI (NYESPP)  GETYS 

EVYRS=  VSYCI  { NYESPP  )*=^2  GETYS 

. • GETYS 

GETYS 

TEMPORARY  DEBUGGING  PRINTOUT  . GETYS 

GO  TO  900  GETYS 

GETYS 

PICK  UP  ESTIMATED  YIELD  AND  YIELD  VARIANCE  FOR  PREDICTION  DATE  GETYS 
200  11=  6 • GETYS 

DO  210  I=lt6  GETYS 

IF  r IZPKDD(II)  .EO.  0 ) GO  TO  210  GETYS 

IF  ( PPOATE  .GE.  IZPROO(II)  ) GO  TO  220  ' GETYS 

2101I=II-l'  GETYS 

ERROR.  PREDICTION  DATE  PPDATE  .LT.  ALL  ZULU  PREDICTION  DATES  GETYs' 
ON  YESOUT  FILE.  GETYS 

IARG(1)=  IPO  GETYS 

IARG{2)=  PPDATE  GETYS 

CALL  ERRMES  ( 3HCA S r 5HGE TYS r 16 , 0 ) GETYS 

YSTR=  -1.0  GETYS 

GO  TO  900  GETYS 

GETYS 

2'20  ESTYS=  YSCKII)  GETYS 

EVYRS=  VSYCI  ( 1 1 GETYS 

GETYS 
GETYS 

TEMPORARY  DEBUGGING  PRINTOUT  GETYS 

GETYS 
GETYS 
GETYS 
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C 

C 

900 


, 999 


GETYS 

TEMPORARY  DEBUGGING  PRINTOUT  GETYS 

CUMTIMUE 

RETURN  GETYS 

GETYS 

GETYS 

GETYS 

CALL  ERRMES  ( 3H  CA  S , 5HGE  T YS  » 10 » 1 ) GE  lYS 

GO  TU  900  GETYS 

END  GETYS 
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FOR » IS  GROUP 

SUBROUTINE  GROUP  GROUP 

READS  segment  DATA  FROM  THE  CAMS  OUTPUI  FILE  (CAMSF),  SELECTS  GROUP 

THE  ESTIMATED  PROPORTION  WHEAT  FOR  THE  PROPER  BIOWINDOW  FOR  GROUP 

EACH  segment,  AMD  AGGREGATES  THE  SEGMENT  DATA  UP  TO  THE  GROUP 

SUBSTRATA  LEVEL  GROUP 

GROUP 

ARGUMENT  LIST  FOR  ERROR  PROCESSING  " ARGLST 

COMMON  /ARGLST/  ARGLST 

1  NEKRS  t.MFATAL  ,MPERRS,NARG  ,ARG<10)  ARGLST 

DIMENSION  lARG(lO)  . ARGLST 

EOUIVALENCE  ( IARG,ARG  ) • ARGLST 

ARGLST 

CAS  CONTROL  CARD  INPUT  DATA  AND  CONSTANTS  ‘ CASCM 

COMMON  /CASCM  ■/  ’ ' CASCM 

1 AREACF,YCF  ,PRDCF  ,APRUTS(4,2)  ,PPRUTS(5,2)  ,YPRUTS(3,2)  CASCM 

2 , AREAPS ,S2MAX  ;MHISTY,HH  ,T0PT  , AON  ITS ,01 STFF , BW IN0( 4)  CASCM 

3 ,WPK10R(4)  ,APREP  ,IPRD(3,14)  , MP DAT E , PR DA T E { 1 4 ) CASCM 

INTEGER  HH,  TOPT,  AUN I T 5 , D I ST FF , BW I ND , W P R I OR , APRE P , P RDATE  CASCM 

CASCM 

FLAGS  AND  COUNTERS  FOR  CAS  SIMULATOR  CASFLG 

CUMMUN  /CASFLG/  CASFLG 

1 H ,PPFLG  ,NBW  ,IBW  , window, IPO  ,IPP  ,PPDATE,NREGS  CASFLG 

2 ,NZTOT  ,NSTRAT,NYESSK,NSSHSK,NCAMSK,NRYES  ,MRSSH  ,MRCAMS  , ' CASFLG 

3 ,ENDC  ,ENDREG,ENDZGN, IRSTR  , I R ZON E , I RR EG  CASFLG 

4 ,LDS1  ,LDS4  ,LDS7  ,LDS8  ,LDS9  ,LDS10  ,LDS11  ,LDS12  ,LDS13  CASFLG 

5 ,LDS14  ,LDS15  ,LDS16  ,LDS17  ,LRCOUN ,LRREG  ,LRZ0N6 ,LRSTR  CASFLG 

INTEGER  PPFLG  , WINDOW  , PPDATE  CASFLG 

CASFLG 

CAS  DATA  SETS  1,2,  AND  3 ' DSETl 

COMMON  /DSETl  / . DSETl 

1 1SUBST,TWAK  ,HWAI<  ,EWAK  ,hlK  ,CT1K  , AN  Al.  VK , E PWK  ,EPW2K  JULY76 

2 , SMPKPI  ,SUMPI<2  ,SUMPK  ,KSUB  ,NCLASS  , JULY76 

REAL  MIK  , M2K  JULY76 

DIMENSION  DSETK14),  nSET2(14),  DSET3(6)  JULY76  ' 

EUUIVALEMCE  ( DSETl , DSET2 , DSET3 , I SUBST  ) DSETl 

1 , ( M2K,M1K  ),  ( CT2K’,CT3K,CT1K  ) DSETl 

DSETl 

FILE  DEFINITIONS  AMO'  RECORD  LENGTHS  FILES 

CUMMUN  /FILES  / FILES 

1 SEGID  ,LSEGID,CR0PW  ,LCROPW ,SUBHST ,LSUBH  , ACQUIS, LACQ  FILES 
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2 tCAMSF  ,LCAMSF,CAiMERRrLCAMER  »CASF  ,LCASF  » Y E SHUT  , LY  ESO  FILES 

3 , SiGEXTtLSIGEX  »YESERR,!-YESER,  SEGTRU,LSEGTR,CASDIS,LCASD  FILES 

4 , INP  ,()UTP  ,TAC0  tLTACO  rCASDSF  , LC A SDS  • FILES 

INTEGER  SEGID  ,CROPW  , SIJBHST  , ACOU  IS  , CAMSF  ,CAMERR,CASF  ,YESOUT  FILES 

1  ,SIGEXT,YESERRfSEGrRlJtCASnlS,nUTP  »TACQ  tCASDSF  FILES 

C - . FILES 

C LEM  CUNTRnt  CARD  INPUT  DATA  LEMCM 

CUMMUN  /LEMCM  / LEMCM 

1 TITLE(IO)  ,ICASE  , CUMTRY ^NT R I AL , RST ART » I PR  I NT , ST ARTR , ST Ak l A LEMCM 

2 ,ENDR  ,EMDZ  tISTG  tICAMS  ,IYES  ,IACO  , I CL  ASS , I SE XT  »ISCC  LEMCM 

3 ,ICAS2  ,ICAS3  , 1 PRC AM , I PR Y ES » I PRC AS t I C S ESG t I QS ECW t IC SESH , IC SECE  LEMCM 

4 , ICSEYM,ICSESE» ICSEAC,RSEEDl, RSEED2,RSEED3, RSEED4,RSEED5tRSEED6  LEMCM 

5 ,RSEED7tICSeST,ICSEC0f ICSEYS,ICSECU,ICSECO  LEMCM 

DIMENSION  RSEED(7)  LEMCM 

DOUBLE  PRECISION  RSE6D  ^ R SEE D 1 , RSE ED2 , R S EED3 , RS EE D4 , RSE EDS  LEMCM 

i ,RSEED6, RSEED7  LEMCM 

EQUIVALENCE  ( RSEED,RSEEDl  ) LEMCM 

INTEGER  RSTARTf STARTR,STARTZ,ENDR  ,END2  ' LEMCM 

C . LEMCM 

C SEGMENT  DATA  FROM  CAMS  OUTPUT  FILE  (CAMSF)  SEGDTA 

COMMON  /SEGDTA/  SEGDTA 

1 IDSEGT(5)  ,ISEG  tTPWKI  »ZAC|}AY(4)  ,EPWKI(4)  SEGDTA 

2 ,ERRPWI(4)  t.ESTPWl  SEGDTA 

INTEGER  ZACDAY  . SEGDTA 

C SEGDTA 

C SUBSTRATA  HISTORICAL  DATA  FROM  SUBHST  FILE  SSHDTA 

COMMON  /SSHDTA/  SSHDTA 

1 CUUN2  »IREG2  T I ZONE2, ISTRA2t ISUBS2,NSEG  ,IDSEG  , GRPNO  ,HISTPW  SSHDTA 

2 ,AREAK  tPWK  ,MAGR  ,NA  , DELTPW t DE LTPM , CV 1 ,CV2  »CV3  SSHDTA 

3 »CV4  , VMULTK, CLASS! 18 ) ,MXK, RDSSH  JULY76 

INTEGER  GRPNO  , CLASS  , RDSSH  JULY76 

DIMENSION  SSHDTA!39)  JULY76 

EQUIVALENCE  ( SSHDTA,  COUM2  ) SSHDTA 

C ■ SSHDTA 

C DEBUGGING  PRINT  FLAG  GROUP 

COMMON  /DEBUGF/  DEBUGF  GROUP 

C ■ GROUP 

C '•  GROUP 

DO  490  N=1,'nSEG  GROUP 

C READ  SEGMENT  DATA  FROM  CAMSF  GROUP 

NRCAMS=  NRCAMS  + 1 GROUP 


t) 

cj  00 
TO 

I 

tJl 

sD  O 
ro 
sO 

§ 


. m 


oo  ooo  Ono  ono  .noonoo 


READ  (CAMSF)  I DSEGT  , I.S6G » T PWK  I , ( Z ACD  AY  ( I ) , E PWK I { I ) , ERRP  W I ( I)  GROUP 

1 tI=1»4  ) GROUP 

GROUP 
GROUP 

TEMPORARY  DEBUGGING  PRINTOUT  . GROUP 

GROUP 
GROUP 

TEST  FOR  CONSISTENCY  BETWEEN  CAMSF  AND  SUBHST  GROUP 

IF  ( IDSEGT(2)  .NE.  IREG2  ) GO  TO  120  GROUP 

'if  { IDSEGTO)  .NE.  IZ0ME2  ) GO  TO  120  GROUP 

IF  '(  IDSEGT(4)  .ME.  ISTRA2  ) GO  TO  120  . GRtlUP 

IF  { IDSEGT(5)  .EO.  ISUBS2  ) GO  TO  200  . GROUP 

INCONSISTENCY  B ET WE EN  .C AMSF  AND  SUBHST.  GROUP 

REGION,  ZONE,  STRATA,  AND/OR  SUBSTRATA  FROM  CAMSF  AND  SUBHST  GROUP 
00  NOT  AGREE.'  GROUP 

120  CALL  EKRMES  (3HCAS, 5HGR0UP , 11 , 1 ) GROUP 

GU  TO  900  GROUP 

GROUP 

200  IF  ( PPFLG  ,E0.  0 ) GO  TO  300  GROUP 

GROUP 

PPFLG  = 1.  PROCESSING  PREDICTION  DATE.  GROUP 

DU  210  1=1,4  GROUP 

WINOGW=  WPRIOR(I)  • GROUP 

IF  ( WINDOW  .EO.  0 ) GO  TO  490  . . GROUP 

IF  ( ZACDAY( WINDOW  ) .EO.  0 ) GO  TO  210  GROUP 

IF  < ZACDAY (WINDOW ) .LE.  PPDATE  ) GO  TO  400  GROUP 

210  CONTINUE  ■ ' GROUP 

GO  TO  490  GROUP 

GROUP 
GROUP 

BIOWINDOW  BEING  PROCESSED  GROUP 

300  WINDUW=  IBW  GROUP 

IF  ( ZACDAY( WINDOW ) ,E0.  0 ) GO  TO  490  GROUP 

GROUP 

CONVERT  EPWKI  FROM  PERCENT  TO  FRACTION  GROUP 

400  ESTPWl=  EPWKI  ( WlNDOW):»:<0. 01  GROUP 

C EQS.  2A,3A  OR  2R,3B’  GROUP 

'■  EPWK=  EPWK  + ESTPWI  . GROUP 

EPW21<=  ePW2k  + ESTPWI«>!'2  GROUP 

M1K=  MIK  + 1.0  GROUP 

490  CONTINUE  GROUP 
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c 

• 

GROUP 

IF  ( MIK  .EO.  0.0  ) GO  TO  900 

GROUP 

c 

EOS.  4A-6A  OR  *4B-6B' 

GROUP 

SMPKHI=  HISTPW«EPWK 

GROUP 

SUMPK2=  MIK’^H  ISTPW**2 

GROUP. 

SUMPK  = M1K--HISTPW 

GROUP 

900 

RETURN 

GROUP 

end 

GROUP 
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000001 

SDBROUT  I IIF  I BET  A 1 ( X t A , B , P 1 1 ER ) 

00000,2. 

c 

. ' 

oooooi 

c 

rOHPUlf  iNrOHPt.FTE  BIT  A INTEGRAL  FOR  ARGUMENTS 

oooooa 

c 

X bfimefn  ^fro  And  onf,  a amo  b positive . 

000005 

c 

000006- 

c 

X VAI.UF  TO  WHICH  FUNCTTON  IS  TO  lit  INIEGHATtO 

000007 

c 

A FIRST  INPUT  PaRA'IETER 

OUOOOB 

c 

B StrONl)  INPUT  PARAMETFK 

000009 

c 

P OUTPUT  PRUHaIIIUTY  (MAT  A RANUON  VARIARLF  FROM 

0000  1 0 

c 

beta  OlSTRUitniON  having  paramfter-s  a and 

0000  I 1 

C ■ 

Mill  f‘-fc  LFSS  Than  or  toUAi.  to  x 

000012 

c 

lER  . FRPriR  FLAG  wIlH  POSSlOlt  VALUES 

0000  1 i 

c 

S40  X not  OMWfFJ  RANOL  0 10  I 

000014 

c 

= 50  A AUn/OR  b (10  1 POSTTIVf 

00001  5 

c 

= 60  GAMt-l.A  function  RANGE  VIOLATE.!)  (NOT'  ,GT. 

OOOO  1 6 

c 

. 

00001  1 

LOGICAL  INOf X 

000018 

c 

TEST  roR  AOHiSsibiLin  OF  arguments 

0 0 0 01  9 

OATA  ACU  /l.L-8/ 

000020 

P = X 

000021 

IFR=50 

000022 

IF(A,1f.O,  .ok,  B.Lt.O.)  RETURN 

000023 

\ 

IFR  = 40  *• 

000024 

iFIX.tf.O,  .OR.  X.GE.l.)  RETURN 

oo'noP'j 

UR  = 0 

000026 

' c 

O0OO27 

c 

CHANOf  Tail  if  mlcessary  and  determine  s 

000028 

A.Sb=A  + B 

000029 

CX=1,0-X 

0000-30 

tru.r.p.ASbvx)  go  to  lo 

000031 

xx=rx 

000032 

cx=x 

000033 

AA  = !! 

000034 

Bli  = A 

000035 

INt)FX  = .7RUt, 

OOOO  36 

GO  TU  20 

000037 

to  XX=X 

000038 

AA  = A 

000039 

t!li=b 

000040 

INOFXc. FALSE. 

000041 

20  TT  RM=1  .0 

000042 

AI=1.0 

OOOO 43 

P=1.0 

0 00  0 4 4 

N5  = nB  + C>t’ASf> 

000045 

c 

000046 

c 

USE  SnPFR  RFOUcTlON  FORNUInE 

0 0 0047 

RX=xx/r:x 

000040 

30  TFHP=HR-At 

00O049 

IF(US.|  0.0)  RXsXX;  ■ 

000050 

40  TtRH=T(  RMtlFuRARX/CAA-fAT) 

OOOOM 

P = P-fTI  f(N 

000082 

n iii’cahmtlhh) 

ouOosi 

IF{Tl Hp.LF .ACU.ANO.TEHP.LE.ACU^P)  GO  TO  50 

000054 

AI=AI41.0 

0U0U55 

N.S  = NS-1 

000056 

U (US.Gl .0)  GO  TO  30 

0 0 0 0 ''t  7 

UMn  = A;,P 

00 0058 

A!iU=ASH3l.O 

88.) 
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000059 

RFAr>(SFGTf?U)COUN4»XREG4,IZ0NE4 

INITI  . 

000060 

IF(r.(niN4,Nt.4HZZ2Z)  GO  TO  10 

INITI 

000061 

NARf.=0 

INITI 

000062 

CALL  FRF?MES(4HCAMSf4HTNlTf  Itl) 

INITl 

OOOOiSi 

■ RTTUKH 

IMITI 

000064 

10  CONTIRl'lK 

IMITI 

000065 

IF  ( (IR6;G4.NF  ,STARTR,OR,TZONE4,NF,STAk7Z)  ,ANO»STARTH'.NC.O)  GO  TO 

201NITI 

000066 

■ BACKbPACE  SFGTRIJ 

IMITI 

000067 

c 

INin 

00006D 

c 

PASS  nVFR  HEAOtPS  ON  OTHER  INPUT  FILES 

INITI 

000069 

c 

SAVE  WlMoflW  NAmFS  from,  ACOUISf  OPEN  OA  FILE 

INITI 

000070 

?3  CONTINuF  ‘ ... 

INITI 

000071 

iFUArOO.Of.O)  go  to  30 

. INITI 

000072 

RFWINO  ACOLIIS 

INITI 

000073 

JirAO(AcOUlSI iSKPf ISKP,1CAS(2) , ISKP t I SKP » HE AO 

IMTI 

000074 

CALL  T6AVP  (OrOtlBAO) 

INITI 

000075 

30  CONTI  HUT 

INITI 

000076 

IF  (ItAHl k.GT.O)  GO  TO  40 

INITI 

000077 

RFWINO  CAMhRR 

INITI 

000078 

- 

RFAOlrAMEOhOlSKPf ISKP,IrAS(3) 

INITI 

000079 

40  loniimuf  ' 

INITI 

000060 

IFdCkOPW.OT.O)  GO  TO  50 

INITI 

0000«1 

RrHiun  rHOPx 

1 N 1 n ' 

000082 

RF  Afi(CHOPW)  ISKPtlSKPf  ICaS(4) 

1M71 

000083 

50  CONTIMuF  * 

INITI 

000084 

IF  ( ISTG.GT.O)  go  to  60 

INITI 

000085 

REWIND  SlOhXT 

IMTI 

0 0 0 0 fi  6 

Rf ADISiCEXT) lSKPtISKP,lcAS(5) 

INITI 

000087 

60  CONTINuF 

INdl 

OOOOH8 

c 

INJ  TI 

000089 

c 

OUTPUT  hfadfr  of  output  FTLE 

IMTI 

000(100 

KFWTMD  CAMSF 

INITI 

00 0091 

nOTal  cAMfir'lS 

INITI 

000092 

KRl  TL(cAMSF)NArIE(  1)  tNAMF(2)  t ICASEt  IMOOELt 

' ifJl  TI  ’ 

000093 

1 ICAs(31,ICASfP)tICA5f4) , ICASd) , ICA5 (5) » IMULT d ISCCf ICI AS$i 

IMT! 

000094 

1 lSf.XTTlAGn,ICAMS»  dFlt.L*l  = dlTOT) 

INJTI 

000095 

return 

INITI 

000096 

END 

INITI 
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l^LT  INITtl  T760«27t  3')o^3 


1 


oooool 
000002 
000005 
00000^1 
ooooos 
000006 
000007 
OOOOOfJ 
000009 
000010 
•00001  1 
000012 
0000)5 
0 00  0 1 '1 
OOflO  1 s 
000016 
000017 
0000 1 0 
000019 
000020 
000021 
000022 
000025 
000020 
00002b 
000026 
00002/ 
000020 
000029 
0000^0 
000051 
000052 
000055 
000054 
OOOO  5b 


suoruutinf  intt  ifin. 

C INTtTAI  I7ATI0N  KOOTlMfc.  INITIAIZES  RANOOM  MllM!5Ei?  StRDS  IKflT 

C WOITTS  tit Al)L« '«tCOF^OSf  tic.  INIT 

C Il^IT 

c ■ rutiKOM  mocK  ortiNTTioNs  imit 

C CUNt1?0|  t’AKAMF-ItRS  fOK  LFH  PROGRAM  UnOL 

COMMON  /CNTRI.  / C*'nRL 

1 PRiNTt  .MSTART,StFU(7)  • CMRL 

INTF-OtK  PRllttf  tNIRL 

OnUOLF  PRtUSlON  SFEl)  ‘ CMRL 

C'“‘  - . . CMIRL 

C l.hK  f.OMTIiOL  CARD  luPlll  UATA  LtMGM 

COMMON  /I  t!tC.M  / LI  MCM 

! TlTlFdOl  flCASF  ,C'JNTHY,N|RIAL»R5TART,IPR,lNTtSTARTP»STAKTZ  II  MCH 

2 lEitflR  »LM!)/  fISTG  .ICAMb  tlYFS  iUCO  » 1 Ct  ASSt  ISt  VT  tISCC  iFhCM 

5 tKASP  tKASi  flPRCAMtlPRYtStlPRCASfirSlSGflCPLrKtlCsrOMflCStrE  LFMCM 
n »Kr.tYM»KSbSFf  USLACfKStEOt  tRSFtn2,nStE05TP5ELI''4iH?LF0b*RbFt()6  LtMCM 
■5  .RiiFbr'/tKSCSTjTCStCO«lCStYStICSLCUf  iCStCO  LFnrM 

Dnil.or.lON  l'SFE0(7)  lfhcm 

DOUPLt  PRrciSlON  liSEFD  f KOftr)  1 , RSEEIJ?  WISEt  r>5 1 kSEFDU  f WSEt  Ob  LFMCM 

I tR5t)  OotkSF.I  07  ItMfM 

tOUTVAirurt  ( RbFtO.pSFEOl  3 LI  MOM 

IHTFOFk  • [i6TAPTtSTARTP*RrARTZ.E.''J0R  .tNOZ  Lf'MCM 

C LKITM 

C INIT 

C LIMkAGF  ...  CAI.LFD  from  lEM  OFIIVFR  INIT 

C I*- IT 

C INIT 

C initialize  random  NUMbFH  SEEDS  INlT 

DO  10  1=1,7  IMiT 

SFt:nn)=  PSFEl'(I)  ■ INIT 

10  CONTINUE  INJT 

. return  • ■ INIT 

END  INIT 
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000001 

00000< 

000003 

0 U 0 0 0 0 
oooons 
000006 
000007 

oooooo 

000009 

00001  0 
000011 
000012 
000013 
OOOOH 

oonois 
(1 0 0016 
000017 
000016 
0 0 0019, 

oooo?o 

oooo?i 

0000?2 

0000?3 

0 0 n 0 ? a 

O«00?6 
oono?6 
nooo?7 , 
oono?« 

OOOOP9 

oono'^o 
(lOoo'U 
0000'\2 
on  0033 

000039 
00  0 0 5.S 
0 00  0 '‘6 
000037 
0000^8 
000039 
000000 
doooo  I 
000002 
00000,3 

(lonooo 
0000o'3 
000006 
000007 
000006 
000009 
OOOO'IO 
OOnuM 
0000'j2 
000063 
000060 
000066 
n0f)066 
006067 
0 0()0''0 


ILT  INlTIt’l  f 7600?7t  3<5007 


C 

C 

C 

C 

C 


SUbPOUTiNF  INIT I<ISFG,lACQUf ICAMERtlCROPWtlSIGf HEAD* ITSFG) 

THIS  SUiiPOUTINf  IHITIA1I7ES  THF  INPUT  'FRES  AHG  OUTPUT  FILESt 
HFaOY  ,Tn  PROCESS  fRrAO  PAST  MEADERSftTC.) 

CAMS  CONTROL  CARD  INPUT  PATA 

COMMON/CAHSCM/  I flOuF L 1 1 HUL T I « I 6 1 GE X 1 1 SK I P t IT  MAX t IRLP » I W I NO » 

1 ir.RdUf’C  5f  2t  16)  »HS  C3*2f  31  tO(  3t  2»2)  »H  C3»  2»2) 

REAL  MS 

Flit  DFFiNinuMS  and  hflohd  lengths 

COMMON  /FILLS  / 

1 RLGID  ,LStGintf.KOPW  , LCROPW  t SUHHST  t LSU6H  t ACCU I S » L ACO 

2 tCAMsF  .LCAMSFtCAMERRtLCAMtPfCASF  tLCASF  » YLSOU T f L YESO 

3 tSir.hXr»LSlGE>f  f YUStiTRRYCStRf  SLG  IRUtLSLCTRtCASUISfLCASD 

0 »THP'  fUUTP  )TACO  ,LTACQ  ? C ASDSF »LC ASD5 

INlFUEl!  StGlFl  , CPOPW  ■ t SUBHS  1 1 ACUUIStC  AMSF  t CAMERRir  ASF’  •YES 

1 iGTGFxT  »YtSI  RR'fSEGTKUfr.ASDiSrOUTP  »TACU  »CA'_SDSF 

• AHCUMLNI  list  FOR  ERROR  PROCESSING 
COMMUN  /AROLSl/ 

t MLRrS  ♦JJFATALiNPFRRSfNARG  fAK'G(lO) 
dimension  IARG(IO) 
tnUTVALFNCt  ( lARGtARG  ) 

COMMUN/SF,GTKU/COUN«»  I6tG9»  IZONtO  * ISTR  A9 1 1SU09  » ISEG9 1 
t 7r,iPRIOR(6)flSPW,Pl(2) 

LLM  CONTROL  CARD  iNPljT  UATA 
COMMON  /I  tl'CH  / 


YE80UT 


,CUNTRYfHTKIALtRSI AHTf IPRINTfSTARTRtST  ARTZ 
,1CAM3  *IYES  tIACO  i I CL  ASS  . I SEX  f »I'SCC 


1 TUlFCIO)  flCASE 

2 tFHOR  ?F.ND7  .ISTb 

3 •rTCAS?  iiCAS3  1 1 PRC  AM » I PR  YES  1 1 PRC  AS  1 1 CSFSO  ♦ 1 CShCrt  1 1 CSFSH  » I CSECE 
9 • ilCsi  YMi  irsFSE  f ICSLaC  »RShEl)l  ,RSEtr>2fRStED3»RSF  Ln9*KSLED6tR'bEtl>6 
5 ! TRSEr07,icsfsif iLSLcOticbEYSj rcsecu.irsFcn 

' D’TMFNSiON  R6ttO(7) 

(JOUHLC  PRfLlSlON  KSEFU  i HSEED  1 i RSt  R(>?  t RSEED3  t RSEEDO  » RSEt  D'i  ^ 

1 fPstfl>6,RSEFi)7  ’ ■ 

tOUTVALFNrE  ( RSFED,RSFED1  ) 

INTIGIR  KST  art  tSi  ARTRf  STARTZ  tENDR  itNOZ 

CmtHUM/INDX/  lNOtX(  1 ) , I PO INI ( 200  I ) . 1 PNT 2 ( 200  I ) f IPEND i IPIN 
COHMON/TKA  IN'S/  COUN 7 1 1 Rt (17 » 1 ZONE 7 7 ISTRATt  1SUP7  7 ISbG  7t 

1 irwiN(97?6)7nTOTfTMM(379726)tT66t379t26)tTVVOi972'3)f 

I TPTRlifcf  ITZOLUl  9)  7 TPER  i (9J  7 TPERH  14)  1 1 F’KTUT  ( 3)  7 T.H  ( 3)  t fV(3)  7TB  C3) 
INTFGI  H TIZULO 
DI-HrNSlON  I TRAIN!  129) 
tOUTVALFNCl  ( I TRAIN, COUNT) 

COMMON/TACO/IHOI  0(9f 1?9) 7 IHP 
DtMFNMniJ  1IFA'>(  9t'9)7  NAME  (2)  7 ICAS  (6) 

DATA  MAHt /OHCArtSfOll  CUT/ 

data  IcAS/6*0/ 

DATA  ipILL/O/ 

read  TU  first  record  on  SfGTKU  AND  BACKSPACE 
IFdsf  G.GT.O)  go  to  26 

RCFiIiJO  5LGT6U 

Rl  AHCSMURUI  iSKPf  TSKP,IrASU)  tlTSFG 
20  cftNritnjf 


INITI 

INITI 

INITI 

INITI 

INITI 

CAhSCM 

CAHSCM 

camscm 

CAHRCM 

camscm 

F ILFS 
F UFS 
FILES 
I ILE6 
F ILF'S  ■ 
FILFS 

files 

FILES 
ML'-S 
ARGLSX 
APol  ST 
APGI.ST 

apglst 
ARGl ST 
API, I ST 
SF’GTRli 
SI CTRU 
Lf  MCH 
LI  MCM 
LI  MfM 
LFMCM  . 
LFMCM 
LFitCM 
LF  HfM 
LFMCM 
U MCH 
LFMCM 
LFMCM 
LFMCM 
LFMCM 
INIX 
IRAINS 
IPATnS 
TRAINS 
IRATnS 
IRAInS 
TRAINS 
1 ACO 
IMITI 
INITI 
INI  II 
INITI 
IN]  n 
INITI 
IN.ITI 
Xf'JTl 
■ INI  n 
INIII 
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000059 
000060 
000061 
000062 
000063 
000060 
000065 
000066 
000067 
0«006i» 
0 bn  0 60 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
OOOOP'l 
0000«2 
000063 
•000084 
000085 
000086 
0U0OH.7 
000088 
'000089 
000090 
000091 
000092 
QOO093 
000094 
000095 
000096 


■■■  .RFAD(8f,GTRUKCIUN4*IRK;g4,1Z0NE4 
IF{r.miN4.Nt.4HZZZZ)  GO  TO  10 
MARO=0 

CALL  FrRMES(4HCAHS»4HTNiT  1 1 f 1) 

RRSIRi; 

• IF ( ( IRkG4.NF ,ST ARTK .OR, TZ0NE4.NF«STAKTZ) . AND.ST ARTK .NE«0)  GO  TO 
BACK6PACL  SEGTRU  ' , 

PASS  nVFt?  HEAOFPS  OM  OTHER  INPUT  FILES 
SAVE  HlHoOW  NAMFS  FROM  ACOUISt  OPEN  OA  FILE 

S5  continuf 

IF  (T  ACOU.OI  .0)  GO  'TO  30 
RFWT'nO  ACOUIS 

nrAD(AcOUIS) iSKPf ISKP.lcASCa) * ISKP V ISKP t HE AO 
CALL  TSAVF  (OfOtiUAO) 

30  CONTir:uE 

IF (ICAMrR.GT.O)  GO  TO  40 
RTWTNO  CAPHIK 

KKArKCAPtRR) iSKPfISKP, ICAS{3) 

40  CONTIHot 

ifcicpoph.gt.o)  go  to  50 
RFhJNO  CKOPW 

R[  AtnrK0PWI  lSKP.lS8P»TCAS(4) 

SO  CONTlHuF 

IKdSIc.GT.O)  GO  TO  60 
RfWINO  SlGbXT 

RT  AI)CSlC.EXT)ISKP»ISKP,IcA8(5)  ■ 

60  continue 

OUTPUT  HfADFR  OF  OUTPUT  FTLE 
RFWTOn  CAHSF 

nOT  = l cAHSF-15  ■ . 

HR  I T t (rAHSf  )N‘Artrn)»NAMF(2)tICASEilMor)ELt 
■ 1 iCA?(3),ICASf21tlCASf4)T  tCASUT.ICASfSTdP.ULTl.lSCCtlClASSt 
1 lSLXT»lACOflCAI-lSt(lFlLL»I  = l*ITOT) 

RETURN 

end  . t 


INITI 
SNITl 
INITI 
INITl 
■ IT  ITI 
U’lTI 

201Nin 

■ 1 N 1 T I 

INITI 
INJTI 
INITI 
INITI 
IN'l  TI 
INITI 
IMTI 
iwni 
INlTl 
INITI 
INITI 
INITI 
IHITI 
INITI ' 
INITI 
INITI 
INITI 
INITI 
INITI 
INITI 
INITI 
IT'ITI 
ITUTI 
INITI 
1-N  I T I 
• I'.'ITI 
INITI 
INITI 
INlTt 
INITI 


<L. 
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000001 

000002 

000003 

oooooo 

ooooos 

000006 

00000/ 

oooooa 

000009 
000010 
0000)  1 
000012 
0000'13 
ouoo  1 0 
oonois 
nooolo 
000017 
OOOO'H) 
000019 
000020 
000021 
000022 
000023 
00002') 
0000213 
000026 
000027 
000020 
000029 
0000  30 
00OO31 
0 0 0 0 12 
000033 
000030 
00003b 
000036 
000037 
000030 
OOO’C'39 
0 0 0 0 0 0 
0 0 0 0 0 1 
000002 
000003 
0 00 000 
00000b 
000006 
OOOO'I/ 
000008 
00000'9‘ 
flOOObO 
flOOOM 
0000'12 
0000‘i3 
OOOObO 
OOODSb 
fl  0 0 0 6 
000037 
OOOObO 


» 1 • 


SUHROUTINF  TNPCHK  . ‘ , IK'PCHK 

C SUIIrOUTIMF.  INPCHK  cHFCKS  THt:  V'AHonV  OF  THE  INPUT  PARAHETERS  INPOHK 

C ON  TKt  lfm  control  CaROS^  it  also  reads  thf  headfr  records  op  INpChK 

C FACH  RrOlIjRLO  tNi'UT  FlU  AND  CHECKS  THF  FILENAME*  CASE  NUMHERt  INPCllK 

C AN'n  country  on  THAT  FILE;  ALSO  INPCHK  PRINTS  THE  INITIAL  lUPCHK 

C PRORtEM  status  INFORMATION  INPCHK 

C , INPCHK 

C COIlRriN  OLor.K  DEFINITIONS-  INfCuK 

C ARr.ijNENT  List  FOR  ‘ERROR  PROCFSSINO  ARCt.ST 

COMMON-  /ARGLSr/  AROlST 

1 fILRRS  tNFATALtWRKRRS,NARr,  tARG(lO)  ARoLSl 

DIMFNSlON  lAROflO)  . ARol  ST 

EOUIYAlE'NCE  ( lARGfARG  ) ARGI  ST 

C . AROLST 

C data  block  FDR  GAS  CUMULATIVE  FILE  ' CASCuM 

C CA'S  data  sets  10*  lb,  lb,-  AND  1/  LASCUH 

COMMON  /CASCUU/  CASCUM 

I CAScUM(32),  BUFFRCSOOJ  CASCoH 

DIKFNSiOM  lcAr>f(32),  DSET10C22),  DSETiS(22I,  DSET16(22)  LASt'UM 

1 *l)bfII7f2B)  CAbCljM 

E'jur VA(.  4 MCE  { rCAsCfCAscUM  j CAsnjM 

EOUIValEncE  C D6Fir/j,D?bUb,DbFT'16,DSETl7,CASCUM(b)  1 . CAsCUH 

1 , L SDAM<S,SDAER/*Sf)AERR,SlJAFHC*CASCUM(20)  ) CASClJM 

2 * ( SOPf  KS,SUPLf>2,SfJPrKR.*S(4P£RC*CASfUM(2b)  ) CASCuH 

5 » ( SOYERS,SUYER2TSr)YFRR,SUYERC.CASCUM(?6>  ) ' LAgCuM 

c caecum 

C COHslANT  OUA-NItTIES  FOR  LEM  PROGRAM  COnSI 

COMMON  /CONST  / LONS  I 

1 H.TRmX  tMAXR  ,HAXZ  , IHXSttMENDML*lTSFG  CONS  I 

C CONST 

C FHE  DFFINinONS  AND  RECORD  LENGTHS  ■ FIIFS 

COMMON  /FHF.S  / • files 

1 SLOll)  *LSEGID,CR0PW  jLCRDPh jSUOHST ,LSU0M  ,ACOUIS,LACO  ■ FILES 

2 tCAMsF  jLCAMSF ,CAHtRR,LCAMLR*CASF  tLCASF  , YESOUT tLYESO  FILES 

3 fSlr.FXl  ,LSjr,F;x,YLSEPR,LYE5ERtSEGrRU.LSLGfR,CAS0IS*LCASb  - F ILFS 

« *TMP  tUUjP  tTACU  *LTACQ  tCASIjSF.LCASUS  ' . FILFS 

integer  SEGI-D  ,lRoPH  *suohs  I , ACoU  i s ,'c  amsf  ,CAmFRR*CASF  ♦YCSOUT  f ilfs 
1 *STGrxT*YESERR*SCGTRU*rA5DlStUUTP  tTACO  *CASOSF  FILFS 

C . FILFS 

C INDfX  RECORD  for  CAS  CUMULATIVE  FILE  CCASF)  IXCAsF 

COMMON  /IXCASF/  ' iXCASF 

1'  1XCaSF(  1)  »L1XCaS  . IXCASF 

C IXCASF 

C UM  CONTROL  CARD  INPUT  DATA  LFMCH 

COMHOM  /tEMCM  / ■ ^ LFMCM 


1 TITLFdO)  fICASF  ,COnThY,NTRIALtHSTART*IPRINI,,STARTR»START2  LU1C.M 

2 fEN'l'R  ,ENd7  fISTG  ,1CAMS  tlYFS  t'lACO  * ICLASS,  ISExf  tISCC  LFMCM 

3 *ICAS2  jICASi  t IPRCAM,lPRYE'S,IRRCAS,ICSE:Sr,t'ICSECH,  ICSESHtlCSECE  LFHCM 

6 , IC!!F.  YM,  ICSFSE*  ICSEaC.RSEEDI  t RSFL02 , rSEF.  t>,3  * RSE L))/)  * HSL  E'D‘> ♦ HSEL  1)6  LFmCM 


. b tRSl  FD7,irsl‘bT,KSErO,]CSEYS*l{.StCO*lCSFCD  Lf  MCM 

Oltirt.SlON  RSF.LO(7)  UrHCM 

OnUOLF  PRECISION  RSEFD  , RSFED 1 * RSEED2 , RSEE03 * RS EFD« , RSEEDb  LFMCM 

1 ,(KiFeI'6*RSeEI>7  LtHCM 

F.OUIVAi.FNrt  . ( RSFCOtPSFEOl  ) , LFMCM 

INIFMr  RSTARr.5TARTR*SlART/,tNDR  *FND7  LFMCM 

C LI MCM 

C -STAf  tSTICAt.  INFORMATION  FOR  I EH  STATS 

COMMON  /STMS'  / ■ ■ ' stats 
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■ 

OOOOS9 

1 ITFR  tl'lSt.GTlttWCAHsRfNyESR  tNRI;C(75  »MCASCK*NCA80» 

stats 

000060 

EOUIVALFNrf  < MI^iTtP  ) 

STATS 

00006V 

c 

stats 

00006? 

1 ' C 

lUPCHK 

000063 

■ c 

rwpuTS  ... 

JF'PCHK 

000060 

• c 

aIL  of  THF  OUANTITIFS  in  the  common  BtOChS  /I EMCM/  AND 

IF'FCHK 

000065 

c 

/FllES/  ARE  REOUtKED  6Y  IhPCHrt. 

iUPCHK 

000066 

c 

TN  ADDITIOII  the  UUANIITIES  NTHHXi  KAXR»'AND  HAJfZ  FROM 

IMPCHK 

000067 

c 

/CONST/  ARE  RfcnUTREO. 

IMpCHK 

00006U 

c 

also  heplni  inF'  upon  input  opjunis  sFurcTtn*  some  of  the 

IMPCHK 

000067  ■ 

c 

pOLiowiiio  mrs  May  bf  input  to  inpchk  so  their  hfader 

1 RPC UK 

000070 

, iv 

rFUIHOS  may  HF  niKCRtO  .. 

IRPChK 

0 0 0 0 V t 

c ■ . 

r.  SEf'lO  ♦ CROPW  , SUrSHSIt  CAI'ERR*  YESERRt  SIOtXT,  ACQUIS 

lUPCllK 

00007?  ■ 

<■'  c : 

’ SEC-IROt  CAUSE  , YL.5UUTt  CASE  » CASOIS 

. IMPChK 

000073  . 

c 

! ' ' 

IRPCmK 

000070 

...  . 

* OUTpMTJ; 

ll.'PC.HK 

OOO  1)75 

' c 

NERRS  ’ = NO,  OF  NONFAIAL  ERRORS  DET.ECTFD  ON  I.EM  CONTROL  CAROSINPChK 

000076 

c 

NfAIAL  s no.  of  fatal  errors  OnECIED  ON  Lt  H CONTROL  CARDS. t 

flMPCriK 

000077 

c 

IMPCHK 

000070 

c 

LOCaI  VaPIADI.E'  OEFtniUONS 

IMPCHK 

000077 

c 

FILL  = filler  for  UEaDFR  RECORDS  OF  DATA  FTLFS 

IMPCHK 

000060 

c 

NFILL  = NUMIJEH  OF  RORnS  OF  FILLFR  RFCFSSARY  TO  COMPLETE  RECORD 

IMPCHK 

0 0 II 0 6 1 

c 

IUPCHK 

00009? 

c 

LlNKACf  ...  CALL  ItJPCHK 

IUPCHK 

000093 

c 

INPfllK  IS  CALLFu  F'ROM  INPUT 

IMPCHK 

oooono 

c 

IMPCHK 

000095 

c 

SUnitPUTINES  USFD  ...  ERRMES 

IMPCHK 

000096 

c. 

IMPCHK 

00009/ 

k.pchk 

000096 

c 

IMPCHK 

000067 

c 

IM'PCHK 

000070 

c 

TENpOkARTLY  SET  TCSECU  AND  ICSECD  =:  ICASE 

IMPCrlK 

000071 

ICSFCIIs  ICASF 

IMPCpK 

00007? 

ICSFCDs  ICASE 

iUf'CHK 

00007J 

c • 

IUPCHK 

00007a 

IF  ( NTRIAL  - R.START  ,GT.  NTRMX  ) 

impchk 

000075 

1 CALL  ERRMES  ( SHlEMt 6HINPCHK * it!) 

INPCMK 

000076 

c 

IMPCHK 

0 0 0 0 7/ 

IF  ( RsTART  .ge.  nirial  ) ' 

IMPCHK 

000076 

1 CALL  ERRMES  (3HLFHt6HINPCHK,  2*1) 

impchk 

000079 

c 

impchk 

000  100 

IF  ( StAHTR  ,IT,  0 ) GO  TO  10 

IMPCHK 

000101 

IF  t EnOK  .EU.  0 ) GO  TO  ?0 

impchk 

0001  0? 

IF  ( STAKTR  ,IE,  ENDR  .aND.  ENDR  ,LF,  MAXR  ) GO  TO  20 

IUPCHK 

000103 

10 

CALL  ERRMFS  (3HIEH,6HINPCHK»  3»1) 

IMPCHK 

ouo 1 no 

c 

INPChK 

0 0 0 ) 05 

?0 

IF  ( StAKTZ  .Lf.  0 ) GO  TO  50 

impchk 

000106 

IF  f fnoz  .eo,  0 ) . gd  to  ao 

IMPCHK 

0 0 01  0 7 

IF  ( Start?  ,it.  end?  .and.  enoz  ,lf,  haxz  ) go  to  ao 

lUPCFlK 

000109 

30 

CALL  FRPHFS  '(3HI.EMf6HlNnCHKi  Ofl) 

IMPCHK 

OOO 1 07 

c 

• 

lupCtlK 

0001  !0 

«o 

IF  ( ISTG  .LT.  0 .OR.  ISIG  .GT,  3 ) GO  10  SO 

IUPCHK 

000  )11 

IF  { TCAUS  ,lT.  0 .OR.  TCAmS  .GT.  J ) GO  TO  50 

inpchk 

0001  12 

IF  ( TyFS  .LT.  0 .OR,  lYtS  .GT.  3 ) GO  TO  SO 

IUPCHK 

000  1 )3 

on  TO  <>0 

impchk 

00  0 1 |fj 

c 

ISTg>  ICAHSf  ANu/OR  TYFS  IS  NOT  Ot  1.  ?»  OR  .» 

impchk 

0001)5 

50 

CALL  ERRMES  ( 3HLEH » 6H1NPCHK f Stl) 

ifpchk 

OOO)  16 

c 

im-chk 

0 001)7 

60 

IF  ’C  TcAHS  .NR.  0 .AND,  ISTG  .EO.  O') 

im'chk 

0 001  It) 

1 CALL  ERKMLS  CANLEFttGHINFCHKr  6tl) 

iMpCHK 
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0001 19 
0001?CI 
0001?! 
nooi?<? 
ooni?i 
ouoij’i) 
OOOlP'i 
000 1?0 
ooni?7 
nooipo 

000  l. ’9 

000  no 
ooom 
ooona 
oooni 
00  0 1 ijo 

ooons 
000  no 

0 0 Of?'/ 

oonnu. 
000  nv 
000100 
0 0 0 1 0 1 
oooioa 
000 1 Oi 
. 0 00 100 
000105 

0 0 n 1 0 0 
oonio/ 
0 0 0 1 0 fj 
000 1 09 

0 0 0 1 s 0 
000151 

000 1 sa 

0001S3 
000150 
000155 
00015O 
000157 
OOO 1 so 
000159 
000100 
OOOlOl 
000102 
000103 
000100 
■000105 
oooloo 
000 10/ 
000100 
000109 
oin)  1 70 
(to  (1171 
000172 
000173 
000170 
000175 
000170 
000)7/ 

nooi7» 


70  IF  f ICAMS  .to,  2 ) GO  TO  120 
IF  ( isTG  .FO,  2 ) GO  TO  60 

IF  r TSTC  ,ro.  1 .AND.  (75TART  .FO,  0 ) GO  TO  75 
IF(TS7g  ,FfJ.  3 .AMD.  RSTART  .FQ.'OJGO  TO  75 
IF  { TsTG  .Nf.  0 1 GO  TO  HO 

C I5TG=  0 OH  IST5S  1 AWO  RSTARTr  0.  HEAO  AND  CHECK  HtAOER 

C OF  TMt  SEGHl-NT  ID  FItt. 

75  NFIU.=  t SFGIO  - 0 

ttfWINn  StGlD  • ■ 

HEAD  (SfGID)  AROm»  ArGIOU  1 ARG(1  ) 1 1 TSFfct  ( F ILL  » I»  1 iNF  ILL  ) 
AHOfo)=  'jHtrclU 

IF  ( ARO(S)  .ML.  OHSEgM  .OR.  AKr.(A)  .l.t.  3HF  NT  ) 

1 call  LRHHLS  (3HLFMtt.liINPCHKf  19.n 

NFILL=  LSFGIO  - 1 

WFAD  (sFGTD.)  .^RGCa),  f F ILL  1 1=  1 » NFI I L )■ 

IF  ( .iahgci')  .ne.  ksfsg  .oh.  AHG(2)  .NL.  CUNTky  ) 

1 CALL  tHKMtS  (3MLFH.6)!INPCKKt  7*1) 

RrwiND  Str.ID 

c 

«0  IF  ( TCAMS  .to.  0 ) GO  TO  85 

IF  ( RsTAHf  .GT.  0 ) GO  TO  1?0 

C IC,Am5=  0 Ok  ICAH5=  1 OR  3 AND  R67AR1  a 0,  READ  AN!)  CHFCK 

C HtAoFR  OF  THE  CHOP  WINDOW  FILL, 

fl5  NFll L=  I CROPri  - 1 
RFUtND  CKflPW 

RFAD  (cROI’W)  AH0(3).ARn(«)flAKG(l),  { F ILL  1 1 = 1 .NF  11  L ) 

ARC f 91=  5MCR0PH 

IF  ( AnOn)  .Nh,  OliCROP  .OH.  AHr,(0)  ,NL.  AHWIND  ) 

1 CALL  LRRMtS  ( 3HlF H t 6H1NPCHK t 1 9 , 1) 

* '■  NFIt.L=  i CRUPW  - 1 

RFAD  (CKOPH)  ARG(2)r  ( F I LL ♦ I a 1 » NM LL  ) 

IF  { IaRGU)  ,NF.  ICSFCH  .OR.  ARG(2)  .NT.  Cl'NTKY  ) 

" 1 CALL  F.RRHES  (3HLEMr6HlNPCHK»  3*n 

■ RFhTND  CHOPW 
C 

C RLAd  and  check  ItilAoLR  OF  THE  CAMS  FKHOR  MODEL  FILF,. 

9o  NFl(l.=  ICAHFR  - 3 • ■ . 

RFNU.D  CAMFIRR 

RfAD  tcAMlKl?)  ARG(3),ARG((0»IARG(1)*  ( F ILI  f la  J t^F  ILL  ) 

ARO(o)=  6HCAMFRH 

IF  ( ARt,(3),.Nfc.  ^hCAK5  ..DR.  AHG(aj  .NF.  OM  tRR  ) 

1 CALL  tRHMLS  (iHLEM»6HlNPCHKil9j'n 

NFII  L=  LCAMFR  - I 

READ  frAKFRR)  ' AKG(?),  ( F IL L 1 1 = 1 » HF 1 L L ) 

IF  ( IaRG(1)  .NF,  ICSFCF  ,UR.  AHG(2)  .NF.  CUNTRY  ) 

1 CALL  tHRMtS  ('3HLFM»6HJNPCHKt  9.1) 

RtWlND  CAMtHR 

C ' 

C PFAd  ANO  check  header  of  the  SIGHATURE  EXTFIJSION  FILF 

loo  NFILL=  I 5U.FX  - 3‘ 

RFKTNO  SlGtXr 

RfAO  ffUGfXT)  AHG(3)  jARGtOT  f IAHG(  n » ( F ILI  f I s 1 f NF  T LL  ) 

ARGfOl=  bUSlGFXT 

IF  ( AR015)  ,Nt.  OHSiGt  .OR.  AROl'l)  ,Nh.  OMXU.N  ) 

1 • CALL  ERKMtS  C3HLrHf6HlNPcHKtl9.n 

. NFILL=  I 5It.FX  - t 

RFAD  (sTGFXT)  ARG(P),  ( FILL  7 1« 1 » NF ILL  ) 

IF  •(  IaRG(1)  .FiF.  ICbrSF  ,UH,  AHG(2i  INF.  L'HnTRY  ) 

.1  CaIL  F.HHMLS  f3HLFHttoHINPCHKtjy;S) 


INPCHK 

INPCHK 

INPCIlK 

IMPCllK 

IMPCHK 

IMPCHK 

INPCmK 

irjpriiK 

INPCHK 

INPChK 

IMPCHK 

DfpruK 

u-pchk 
impchk 
INPChK 
IMPChK 
IM’FhK 
IMPC  llK 
INRCHK 
IMPCHK 
Il'PCHK 
IHPCHK 
IMPCHK 
IKPCHK 
IK-pruK 
IMPCHK 
I'-PCHK 
IMPCHK 
IMPChK 
IK'PCHK 
IMPCHK 
JHPruK 
I) PChK 
IMPCHK 
INPCllK 
ik-FChk 
INPCllK 
IMPCHK 
IMPCHK 
IMPChK 
IM'PCHK 
JMPCHK 
IMPCllK 
IMPCHK 
IMPDlK 

IMpniK 
IPPrilK 
IMPCHK 
IliPCT-lK 
IMPCHK 
IfiPCHK 
INPChK 
ll'PCllK 
IM'CitK 
IMPCllK 
IM'PCHK 
I(i|M  l|K 
IMPCllK 
IMPCtiK 
IMPCHK 
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000179 
oooino 
000l«l 
OOO  lft‘2 

0 0 n 1 H 5 
oooino 
OOOlftb 
OOOlflfe 

000  1(17 

00 0 1 no 
(too  1K9 
ooono 

000191 

000192 

000195 

000190 

0001  9'3 
000  1«t> 
00019/ 
000  1 9B. 
000199 
000200 
000201 
000202 
000t;05 
000200 
0002015 

OOn^job 
00020  / 
00020H 
000209 
000210 
00021  1 
000212 
000215 
000219 
0002115 
000210 
000217 

fl002in 

000219 

000220 

000221 

000222 

000225 

000220 

000225 

000220 

000227 

000228 

000229 

000250 

000251 

0002  52 
000255 
0002.50 

00O25S 
000250 
00025/ 
0002  5» 


' ■ " RfWINP  SIOEXT  ■ 

C 

C head  and  check  header  of  the  data  ACOUISTTION  FILE 

lio  NFII.L=  LACO  - 3 . ’ ' ' . 

RPHTi'TO  ACt'lUTS 

HFAD  fACtoiUSj  AI<G(5),A»0<9/f  lARGCn  » ( F ILL  j T a 1 f NT  I Li.  ) 

AK0T6)=  bHACuUlS 

IF  ( ARG(5)  ,»E.  OHACOU  .OR.  ARR(9)  ,NE.  3HtSI  ) 

1 CALL  ERKMES  (5HLFH»6HiriRCHK»I9*n 

NFI1.L=  t Afil  - 1 

READ  (aCDIHS)  ARG(2),  ( F J U » 1 = I f NF I LL  ) 

.IF  { IaRG(I)  .NF,  iCSFAC  ,0R.  ARG(2)  ,NE.  CHNTRY  ) 

't  CALL  ERRMES  ( iHLf'HiOHiNPCHKt  1 1 » 1) 

RPHTND  ACOUISi 
C 

120  IF  ( IyFS  ,F0.  0 I GO  TO  125 
IF  ( .]  yFS  .'FIJ.  ? ) GO  TO  150 
IF  C RsTART  .CT.  0 ) Gn  TO  130 

C IVTs=  0 OR  ITES=  1 OR  5 AND  RSTART  s 0.  READ  AND  CHECK 

C HEA{)TR  OF  The  YLS  ERROR  MuPtL  FILE. 

125  NFIl.Ls  I YFSFR  - 3 
RFaINP  YESERR 

READ  (yFSFRR)  AKG(5),ApGtO)*lAR6n)t  ( KIH  ♦!  = ! »NKILL  ) 

ARG{6)=  6HYFSI  KR 

IF  ( ARf.(5J  .HE.  OHYESE  .OR.  ARn(«)  .NE.  OHPROH  ) 

1 call  ERRKES  (5HLf Ht6HINRCHKtl9tl) 

NFil L=  LYFSTR  - I 

HEAD  (yFGTRR)  ARG(2),  { FILL » 1= 1 t NF 1 LL  ) 

IF  { lARGfl)  »NE.  ICSPYM  .OR,  A»&r21  .NT.  CUNTRY  ) 

1 CALL  EPRHES  t5HLrH*<jHINPCllKf  12tn 

REWIND  YESERR 
C 

C read  and  check  header  of  SlIBSIRATA  HISTORICAL  FILE 

150  NFILL=  I SHijH  - 5 
REWIND  SOI’HST 

READ  (sUURST)  ARG  ( 3)  , ArG  (0  ) » I ARG  C 1)  f I IIXSEG 
AllCrOls  bUSUli'IST 

IF  { ARG(5)  .ME.  OHSUn  .OR,  ARG(O)  ,NE.  OHHISI  ) ^ • 

1 CALL  tRRMES  (iHLFHiGHINHCHKrlSU) 

NFIIL=  LSl'IJt!  - I 

READ  (SUGI'ST)  AKG(2),  ( FILL  » 1 = 1 «Nr  ILL  ) 

IF  (lARG(n.,Nt.  ICSERH  .OR.  AHG(2)  .HE.  CUNTRY  ) 

1 CALL  tRRMtS  (5HLCM*C>HINFCHK9l5*n 

REWIND  SUllHST 
C 

IdO  IF  ( I-CAMS  .EO,  2 ) GO  TO  155 
IF  ( IsTG  .to.  2 ) GO  TO  1«5 
.IF  {.RsTART  .Ft).  0 > GO  TO  150  ' 

IF  ( ISIG  .EO.  0 ) GO  TO  150  ■ ' 

C ISTG  = 2 OR  1STG.=  t OR  5 AND  RSTART  .GT,  0 

1(15  NFILLa  I STGTR  - 5 
REWIND  SECTHU 

READ  rsrr.TRU)  AR0(5)  f AIU,((0  . I ARGO)  t ( F ILL  » 1 = 1 tNF  ILL  I 
ARG(oI=  61!31GTRU 

'if  { ARF.(5)  .NT.  OHRLgI  .OR.  ARG(O)  ,NE.  'IHRUTH  / 

1 CALL  ERRHLS  ( 5HLFH » 6H I NRCHK 9 1 9 t H 

NMILe  ISFGTK  - 1 

READ  fsroTriSI)  ARr.L2},.  ( FILL  1 1 = 1 tNT  I LL  1 
IF  ’(  1aRG(1)  ,.NF..irSFST  .OR.  ARG(2>  .N!  . CORTRY  ) . 
t call  ERHT'LS  f5HLf.H9  6mNRCttK»H9j) 


INRCHK 

inrchk 

inpchk 

IKTCHK 

INPEHK 

INprtiK 

impchk 

iNpriiK 

inrchk 

INpruK 

IMI'CMK 

lopruK 

iNprtiK 

impchk 

IMPCHK 

INPCHK 

IHPChK 

inpchk 

IMPCHK 
U pchk 
li'PCHK 
IMPCHK 
IMpCliK 
IMPCHK 
IMPCHK 

impchk 

IMPCHK 

IMPChK 

IMPCHK 

impchk 

IMpCllK 

IMPCHK 

IM'PChK 

impchk 

ITPCHK 

INPCHK 

IMPCHK 

IMpCriK 

IMpf HK 

impchk 

INPCHK 

IMPCllK 

IMPCHK 

inpchk 

INPCHK 

IMPCtlK 

IM'PCllK 

inpchk 

IHPCFlK 

IMPCHK 

, impchk 

IMPCHK 

INPCHK 

inpchk 

impchk 

IMPCHK 

IMpCHK 

IT'PCHK 

IMPCHK 

iNPCIjK 


28234-6029-RU-00 
Page  470 


000^39 

OOOii'iO 

ooo2«r 
0002'i«j 
ooa?.iis 
0 0 0 2 « (| 
0002^15 
0002^16 
oon2;i7 
0 0fi2/lfj 
0mi2'l9 
00fl2''i0 
0002S1 
000252 
00025i 
00(i2'^0 
000255 
000256 
000257 
000250 
000259 
00  0 2 6 0 
00026  I 
000262 
000263 
000264 
00026S 
000266 
0 0 026  / 
000268 
000269 
000270 
000271 
000272 
000273 
000274 
000275 
000276 
000277 
000270 
000279 
000200 
000201 
000202 
000203 
000204 
000205 
000206 
00020/ 
0002PO 
000209 
000290 
000291 
000292 
000293 
000294 


RFW7HD  StOFRU  ■ ‘ ' ' 15-pCtfK 

c inpchk 

150  IF  r PsTART  .KO,  0 ) on  to  160  15-PCHK 

IF  ( IcAHS  '.KO,  0 ) r,0  TO  l60  IRf'CHK 

C ICAH?  =2  on  ICAMS  = 1 OR  3 AND  RSTAHT  .6T.  0 IM'CHK 

ISS  NFIl,L=  ICAHSF  - 3 ir.'HCllK 

Ml  KIM)  OAMSF  ‘ INPCllK 

RlAD  (CAIISF)  ARG(3)f  AR0(4)»1AHG(1)i  { F ILL » 1=  1 f NF  ILL  ) , UPCHK 

AR6f6)=  5HCAMSF  IMCHK 

ir  ( Auf:(3)  .Nt,  4MCAMS  .OR.  ARn(4)  .Nt,  4H  OUT  ) ‘ . IMPCnK 

r CALL  LRRo.tS  ( 3HL1  M f 6«'lNPCHK 1 1 9 » J ) IMpCllK 

NFII  L=  1 CAM5K  - 1 IMITiiK 

MFAO  fcAMSH’  ARudOf  ( MLL)!  = ltNHLL  ) lApCMK 

IF  ( IaRG(1)  .Nf.  ICSrCO  .OR.  AR6f2>  .50.  Ct'NTRY  ) l);prnK 

1 CALL  tKMMES  t3HLCHt6HINPCHKrlbf  n IMTuK 

RI.WTUD  CAH6F  H PCHK 

C • INCCMK 

l60  IF  C lYlS  .FO.  2 ) GO  TO  165  Il-PCHK 

IF  ( RsTART  ,F0.  O ) Go  TO  170  ICPCIIK 

IF  ( TyF3  .FO.  0 ) GO  TO  170  IfPCllK 

C TYFS  = 2 OH  lYtS  s 1 OR  3 AND  R5TART  .GT,  0 INPCHK 

16*;  NFUL=  LYFSn  - 3 iNPCHK 

KfwiMP  YCSOII7  “ ilipCMK 

MFAO  (vfiiOUT)  AHG(3),ARG(4)»lAR6^n»  ( F 1 LL  » I = 1 f NF  I LL  ) INpCHK 

ARGf6)=  OimsnuT  ■ IKPCHK 

IF  ( ARG(3)  .ML.  3HYLS  .OR,  ARG(4)  .NF.  IH  ) INpChH 

1 CALL  LRRMES  C3MLFN.6H1NPCHK»19»1)  INpritK 


NFll L=  1 YF60  - 1 

HFAD  fyLSr.UT)  AHC{2),  f FILL 1 1 = 1 . NF  1 LL  ) 

IF  ( IaRG(U  .nf,  ICFFYS  .or,  ARG(27  .NE.  CUNTMY  ) 

1 CALL  EHRHtS  C3HLFfl«6HlNPcHKt  I6f  n 

RFKIND  YfcSOUT 
C 

C OPIN  CAS  cOPiULATIVr  FILE 

170  DtHNF  Hit  l4(36P»504>Uf  IDUN) 

C 

'IF  ( RsTaRT  .FO.  0 ) Go  TO  900 

C ' ■ , 

C PtAD  and  check  header  record  of  CAS  CUMULATIVE  FILE 

'CALL  RaNACF  {CA.5Ftl»CASCUH,LCASF,IXCASFfLIXCASi  1) 

COUN=  cA6rUfi(3) 

NTs  iCASttO) 

' A('G(61=  4HCASF 

’ ARG(37=  CASCUMd) 

C shift  FUtNAMt  4 characters  (24  HITS)  TO  THg  LEFT 

C HY  multiplying  ISY  ?»?24 

1AKG(4)=  ICASCCl) *1677/?16 

If  ( CAf'CIIM(l)  ,NF  . - 6HCASCUM  ) CALL  FRRHFS  (3HLEH»  SHiNPCHKi  3 9>  I ) 
■ ■ ' lAKT.C  1 )=  ICASCC?) 

IARG(?)s  rOIIN 

IF  ( ICASCC2)  .Nf,  ICSErU  .OR.  COUN  .Nt.  CUNIRY  ) 

1 CAll  FRRMFS  (3HLEMt6HINPCHK.17*U 
IF  r NT  .ME.  RSTART  ) CALL  LRRHES  ( 3HUFH » 6H1NPCHK »21 f 1) 

C 

900  return 
LN|) 


INpruK 
IF  PFhK 
IF’PCHK 
INPCIlK 
INPCHK 
IFPCHK 
JF'PruK 

IHpr.HK 

INPCHK 

INPCHK 

IFIPCHK 

INPChK 

INPCHK 

INPCHK 

INPChK 

if-pchk 

INPCHK 

INPC.IIK 

INPCmK 

INPCHK 

INPCHK 

INPCHK 

INPCHK 

IK'PCHK 

IF.PCHK 

INPCHK 

IfPCtlK 

INI-CllK 


*NEW 
11*- 1 
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0  FL.T  INPERR»l#76d«27t  3R029  -t  1‘ 


000001 
ooooo^ 
OOOOOJ 
00000(1 
000005 
000006 
OOOOOV 
oooooo 
000000 
00001  0 
00001  1 
000012 

0000  1 i 
000010 
ouool  b 
0000  )6 

00001  / 
ooooio 
000010 
OOOOPO 
000021 
OOOOPt) 
000025 
0 0 0 0 2 'I 
000025 
000020 
00002/ 
000020 
000029 
0 0 00  <u 
000031 
000032 
000055 
000050 
000035 
000036 
000037 
000(1  36 
OOOO 37 
C 0 0 0 '!  0 
OOOO  (I  1 
000002 
000005 
OOOOOO 
0 0 0 0 0 5 
00OOO6 
000007 
0 0 0 0 0 6 
00  oo'io 
OOOC'O 

ouooM 

000052 
0000*^5 
000050 
000055 
OOOO'IO 
00005/ 
(10  0 056 


SUURODtINE  ImPERK  (rCOOR)  iupfrr 

C PRINTS  error  messages  for  THF  LEH  input  processor  ' . INpfRR 

C • lUPKRR 

C input  PARAKtTtR  ...  IMPFRR 

C ICPilf  = ERROR  KtSSASF  COOE  ’ ' ' ' INPFRR 

C INPFRR 

C COHmIsN  ULOCK  OEflNItlONS  INPFRR 

C ARGufENT  LIST  FOR  FKROR  PROCESSING  • AR6I ST 

COMMON  /Awr.LSI/  APGI.ST 

1 Ni  RrS  .NF  ATAI,  tNPkRRS,NARr,  tARRCIOl  ’ ARlll.ST 

OIHRISJON  lAR(.nO)  ■ ‘ AkOl  ST 

EOUTVALFNre  ( IAROiARG  ) '■  ARM  ST 

C ARUIST 

C constant  OUaMUTIES  for  LEM  PROGRAM  CONST 

COMIHIN  /CONST  / CONST 

1 NI'RmX  tHAXR  »MAXZ  ,IMXStG»rNIlF'lLtITSFG  C('NST 

' C ■ ‘ CONST 

C FIt(  IlFFlfiniONS  AMI)  HFCORl)  LENGTHS  FRFS 

COHMOM  /Flits  / F'lLFS 

’ t SLG[t)  aStClOtCROPM  ,LCROPrttSUOMST  .LSUHH  ♦ACOUIStLACO  FILF'S 

2 fCAF'sF  tLCAMvSF'fCAHLRR,LCAMLRtCASF  .LFASF  ♦ YbSOUT  i LVLSO  FUF'S 

3 »51(>hXifL31GPX,YfcStHR»LVtStRtSLGTSU(LStC.TPfCAS0tStLCA5O  F ILFS 

0 fTNP  .UtllP  .TACO  .LTACij  f C A5USF  , LC  ASOS  FILFS 

IfiriGf.’R  RMUn  iCROl’w  .SUnilSr»A(.mUSiCAF'SF'  tCAMUlRtCASl  fYESOUT  FTt.fS 

t tSIGKXTfYLSERRiSFGTRtltCASOlStOinP  »TACU  tCASOSF  FILFS 

C . FUFS 

C I LM  CONIF’Ol  CARt)  iNPUl  GAIA  . LI  MCM 

COHHOM  /ItHCFi  / LFMCM 


1 TllLFdOT  tlCASp  tCUHTHYtNlRIALfRSIARTf  IPPlNIiSTARlRiSTARTZ  LfMCM 

2 flNiR  .LM|1/  flSTG  ,ir.AM6  flrrs  »1AL0  «IU  ASSiIStxT  tiscc  Lf  OCH 

3 »1Cas2  »1Ca55  tTPRCAM,  IPRYLS?  IPFCASi  irsCSf.i ICSLCn. ICSPbH, tCSECL  LI  unt 
" ' ■ n rTCStYHrICSFSFf  TCSLAC,RSEEDl  jRSEEf'2tRSEF(l3tPSFt.O4,RSEF05tRSEk06  LFhCm 


5 »RSf  t r>/,  insrST,  ICRtCO,  ICSfcYSf  iCSLCUt  irSLCl)  LlhCM 

OlMFilSiON  RsF.LOC?)  LFMCH 

OOIIOLF  PRfCISlOR  RSLF!)  » RSEEO I t RS£EU2  f RSFfcDi » HS  t fc  00  » RSEL05  LFmCH 

1 tPSFfOO’RSFf  U7  • LfHCFl 

EOUTVAiFNCt  ( RSFfcOtRSFtOl  ) ' LTMCH 

INIFGFR  RSTaRI iSTAR(R,SlA»T/ttNDR  lENOZ  Lf HCM 

C • U HCM 

C STATISTKaI.  INFORMAIION  FOR  l.bM  STaTS 

COMMON  /SIAJS  / . ' ST  ATS 

I ITFR  ;NStGTR»NCAHRR,NYtSH  , NRFC { 7) . NC A5CR » NC ASOR  STATS 

EOUIVALfNre  ( Hf.ITlR  ) stats 

c • stats 

C ' JNprtjR 

C UlCAl  VARlAllLLS  . ’ - It  pi  HR 

C ■ IMLS  = LRROR  MFSSAGE  COOF.  ‘ ' ' INptRR 

C MXLFM  s MAXIMUM  ERROR  MESSAGE  CODE  ‘ . INPFRR 

C INPFRR 

DATA  mXLFH  / 21  / . . IF'PFRP 

C , , I INptRR 

'C  I INrAGF  ...  CALL  InPERR  CICOOL)  • INPFRR 

c iftPeRH  IS  called  from  ehrhesj 'Kmich  is  calild  .from  inpcmk  impfkr 

Cl  . ' ■ ■ INPFRR 


c ■■  ■ INPFRR 
C ■ , ' ' INPFRR 
C i MOST  ERROR  MESSACtS  OCCUPY  2 OR  3 t,  INLS.  INpFRR 
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0000S9 
000060 
000061' 
00006^ 
000063 
000064 
00006b 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
00007U 
00007b 
000076 
000077 
000078 
000079 
000060 
000081 
000082 
000083 
OOOOfi'J 
OOOQ8'3 
000086 
000087 
000088 
OOOflOV 
000090 
000091 
0 0 n 0 9 a 
000093 
000094 
00009b 
000096 
000097 
000098 
000099 
000100 
0 0 0 1 0 1 
000102 
000103 
000104 

00010b 
000106 
000107 
000100 
000109 
OOOllO 
000111 
000112 
000113 
000114 
0 U 0 11  b 
000116 
000  1 I 7 
0 (1 0 1 1 8 


' ' iHfcSs  iCIJlIfc  U.'HHlH 

IF  ( Ih6S  .t,T.  0 .017.  IMES  .QT.  MXLEM  ) 60  TO  980  INf^FRR 

c hramcm  to  Print  phoppr  messare;  ' inpfrr 

lin  TO  (10,20,30t80t'50,60f70t80t90f  I00»ll0ij20tl30tl«0tlb0tl60fl70  IMF'FRR 
1'  I 180, 190,200,210  INPFK'R 

2 ),  This  iNprRR 

C . INPFRR 

10  HRJTt  (OOTPtlOOl)  -NTRlAltRSTARTtNTRMX  INPFRR 

loot  FORMAT  C48H0TO0  MANY  MOnIF  CARLO  TRTAlS  RCUUESTt'D.  NTRIAL:»T4,  INPFRR 

1 91'  RRTART=T4/iOH  MAX,  NO.  OF  TRIALS  PfcP  RUM  IStl'O  INPFRR 

GO  TO  999  INPFRR 

C . INPFRR 

20  HRITL  (OUTP,1002)  R5TArT,NTRIAL  INPl RR 

1002  FORMAT  (Ot(ORSTART=I4,?VH  MUST  UE  LESS  THAN  NTRIAL=T4)  IPPFRR 

GO  TO  999  iNPFRR 

C . ' lAipri^R 

30  WRITE  (f’UTF',  lOo'?)  S T AHTR  , EMUH , H AXR  I'-'PIRR 

lOOi  FORMAT  (8t(05TARTR  = 18,29H  MUST  Bt  UEIWLEN  0 AM)  EMl)R=I4,  K.pi'RR 

1 20H.  END'’  MUST  UE  .LF.,1'0  INPFRR 

■ GO  TO  999  INPFRR 

C INHFRH 

4o  WRITE  (OUTP,1004)  STARTS, EN07,8AX2  INPFRR 

100«  FORNAT  f 8H0STARTZ  = I8,?9H  MUST  BE  BET'WEEN  0 AMD  END7  = 14,  INPERR 

1 20H.  LMD7  must  t'E  .LF.tIP)  • IMMRR. 

GO  TO  999  INPFhR 


C INPFRR 

bo  HRITL  (OUTFtlOOb)  I STL , IC AMS , IVES  IPPFRR 

1005  FORMAT  (6H0ISTG=I?,9M,  IC A>iS  = 1 ? , 1 2H,  AND  IYESEia,?bH  MUST  ALL  rUNPfRR 

IE  0,1, 2t  OR  3.)  INPFRR 

GO  TO  9P9  • ' INPFRR 

C INITHR 

60  CALL  PAOtR  (1)  IMPFRR 

HRITL  (OUTP,1006)  ICAHStISTG  ' IMPFRR 

1006  FORMAT  C481.I0IF  ICAHS  TS  NON7ERO,  THFN  ISTG  MUST  'UF  NONZERO,/  JfipFRR 

t 6tH  l.l.  IF  TUt  cams  errors  ARE  HFLO  CUNSTANl,  THFN  SO  MUST  THE  If'PFRR 
PSrOMLMT  truth  tRROR,/mi  TCAMS=Ib,8H  lSTG=Ib)  INpFRR 

GO  TO  9P9  INFFRR 

C < • , INPFRR 

70  WRITE  (OUTP»1007)  I ARG ( 1) , I ARG { 2) , I CSE SG , CUnTRY  ’ • INPFRR 

1007  format  (13U0CASE  NUP.8FR  = 1 5 , 1 3H  OR  rOURTRY  ;A6,b7H  FROM  SECMEMT  HNpFRR 
10  F ILf  rOFS  NOT  AF.RF  E WITH  InPUTS  1 CSFSGs lb/ 1 4M  AND  CUNTRY^  A6)  IMPFRR 

GO  TO  999  INPl’HR 


C 


C 


c 


imperR 

80  WRITE  (OIJTP,  1008)  I'''’Ocn  ,IARGC2),ICSECH, CUNTRY  INPFRR 

1008  FORNAT  (I3U0CASF  NUH8F‘K= I b , 1 3H  OR  COUNTRY  ,A6,b8H  FROM  CROP  WTNDINPFRR 
tOH  FUE  DOES  NOT  AGREF  WITH  INPUTS  I CStCW-lN/l  4H  AND  CUNTRYa  A6)  I'JpFRR 

GO  TO  999  ■ INPFRR 

INPFRR 

90  WRITE  (0UTPO009)  I ARG  ( 1)  , I ARG  C 2 1 , I LSLCF  , CUNTR  Y INrfRR 

1009  FORMAT  (13H(>(ASF  NUMHFRslS , ! 3H  UR  rOUHTRY  .A6,S/H  FROM  CANS  ERROINPFRR 
IR  FTLF'IHIFS  NOT  AGREE  wilH  INPUTS  1CSFCF= Ib/ 1 4H  AND  CUNTRYs  A6)  INpf rR 

00  TO  999  InPIrR 

INPFUR 


loo  WRITE  (UUTF,J010)  I ARG { 1 ) t I ARG C 2 ) , I LSE5E . CUNT R Y 
lOlO  FORMAT  (I'^HOl.ASE  NUNUFHa  I b , 1 5H  OR  COUNTRY  ,A6,62H 
ITURF  FxTENSION  Filt  DOES  NOT  AGREE  JOPUIS  / 

2 9H  ILSESI  =15,1411  AuU  CUNTRYo  Ah) 


iNpfRR 

FROM  THF  SIONAIMPFrR 
INPFRR 
INPFRR 


GO  TO  999 
C 

liO  WH17F  (OUTP,)0m  IARIi(n,TARG(2)*ILS!.AC, CUNTRY 


INPf  RR 
INpFRR 
INiTHR 
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000119 

toll 

FOHMAT  C13H0CASF  MUHOpha I S « 1 3H  OR  COUNThY  tA6.67H 

FROM 

THF 

DATA  INPEKR 

ooni?o 

1 ACUlllSlTlON  FILE  I^OFS  Nol  AGKEE  KIIH  INPUTS  ICSIAC* 

:lb/ 

inpfrr 

0001?1 

2 I'lH  AND  CUN1RY=  A6) 

INPEHR 

oooi?a 

■ 

GO  TO  999 

INPfrtR 

000l?i 

C 

INPFRR 

0001P9 

120 

ViRITt  (0UTP;|020)  IAH6(l)fIARG<2)f  tC>StYMiCUNTWY 

lUPFRR 

ooolpy 

!q?0 

format  fl3H0C.A££  MUPbF R=  I b' 1 1 3H  OR  COUNTRY  ♦A6t66M 

FROM 

THE 

YES  F INPFRR 

OOOl^b 

1RR0R  Flit  OOtS  NOT  AORfcf  WITH  INPUTS  ICStYMcll/ 

inpfrr 

000137 

2 1/4H  and  rul!TRY=  A6) 

inpkrR 

ooot?h 

GO  TO  999 

INm(-rR 

000139 

C 

IMPFRR 

ooniio 

' 150 

WRITE  (DUTPtlOiO)  TARGrDf  IAR«(2)  tlCStSHiCUNTKY 

INPFRR 

0 00  ■ ■ " 

to.50 

FORMAT  (13H0CASF  NUM6FR=,1  5,  1 3H  OR  COUNTRY  »A6,63H 

FROM 

THF 

SUHST INPFRR 

00013^ 

IRATA  HISTORICAL  FILE  DUES  NOT  AGREE  RITH  INPUTS/ 

INPFRR 

000133 

? 9U  iCSFSHs Jbf  1011  and  CUNTRY=  Ab) 

INPFRR 

0001X0 

GO  TO  9‘>9' 

inpfrr 

000  1 3'J 

C 

, \ 

INPI RR 

Qoni 56 

1/10 

WRITh  (nUTPfiOOO)  lARGf n *tARG(2) f TCSLST^CUNTRY 

INPFRR 

000137 

lO'lO 

FORMAT  fl3H0C‘SE  NUM6FK= 1 b , 1 3H  OH  COUNTRY  tA6»6qH 

FROM 

THE 

SEGHF INPFRR 

00013S 

INT  TRUTH  FILE  OOFS  NOT  AGREE  WITH  INPUTS  ILStST  = lS/HH  ANO  CUNlKYINpruH 

00O139 

1=  A6)  . 

INPFRR 

0 0 0 1 (1 0 

GO  TO  999 

INPFRR 

000101 

c 

14‘FI-RR 

000102 

110 

HRITL  (OUTPflOSOI  lARGf n TrAR0(2)f ICStCOtCllNTHY 

INPFRR 

000103 

lobo 

format  (IXHOcASF  NUHUFRsIb. 1 3H  OR  COUNTRY  tA6,62H 

from 

THE 

CAMS  inpfrr 

0 0 0 1 0 0 

lOUTPUT  FllF.  DIES  NOT  AGREE  WITH  INPUTS  KStCO=  I S/ 1 <4H  AND 

CUNTRYs  imi-frr 

0 0 0 1 0 s 

2 A61 

inpfrr 

0 0 0 1/16 

GO  TO  999 

INPFRR 

0 0 0 1 11 7 

c 

INPFRR 

000106 

l60 

WRITE  (OUTPflOsO)  lARG(n»URG(2)  »ICSEY5*CUNTHY 

INPF  HR 

000109 

1060 

format  (I3H0CA6E  MUMHrRr 1 b t 1 3H  OR  COUNTRY  9A6,6lH 

from 

The 

YES  niPPFwH 

0 0 0 1 '5  0 

lUTPUT  FILE  DOES  HOT  AGRFE  hITH  INPUTS  KSFYSa  I1/19H  ANO 

CUN  TRY  =ir.‘pFK» 

OOOISI 

2 A6I 

II  P(  RR 

OO01'52 

GO  TO  999 

IM'i'RR 

000113 

C 

INPFRR 

OOClIO 

170 

WRITE  (OUTP»lO)0)  lARGf n ,tARG(2T 1 ICREYSfCUNTHY 

inpfrr 

OOOlSb 

1070 

format  (I3H0CASE  NUM6FR=Ib» I3H  OR  COUNTRY  tA6,66H 

FROM 

THE 

CAS  CINPFRR 

0001S6 

lUH  OUTPUT  FRF  oof:s  noi  acrfe  with  Inputs  icase  = ii/ 

INPFRR 

00011/ 

2 I'tH  AND  CUNTRY=  A6I 

INPFRR 

000116 

GO  TO  999 

inpfrr 

0 0 0 1 S 9 

C 

inpfrr 

000160 

IfiO 

WRITE  (OUTPilOflO)  TAROfn,lARG(2)fICS£CDtCUNTRY 

inpfrr 

000161 

loflo 

FORMAT  (IXHOCASI  N0H6FR= I b r 1 3H  UR  COUNTRY  ,A6f66H 

FROM 

THE 

CAS  DINPFrH 

000162 

IIST  OUTPUT  FILE  OOLS  NOT  AGREE  WITH  INPUTS  ICASE  s 

T5/ 

INPFRR 

00,0  163 

2 lAH  AND  CUNrl'Y=  Ab) 

INPFRR 

00  0 16/1 

GO  TO  999 

INPFRR 

00  0 l(.'i 

c 

inpfrr 

000166 

c 

• 

■ 

INPFRR 

000167 

190 

WRITE  (OUTP*ll90)  ARni6)iARG(3)  *ARG1(I) 

IHPPRR 

000!  Ml 

1190 

FORMAT  (31IIOIMPROPEH  HEADER  LAOGL  ON  FRE  ♦AotlOFU 

LAfJFL 

= 2A/0  IIJPFRR 

000169 

GO  TO  999 

INPFRR 

OOOJ70 

c 

inpfrr 

000171 

?00 

WRITE  (POTPi1200)  ARn(l)' 

INPFRR 

000172 

1200 

format  (61  HOIMPRliPtR  1 AntL  AND  SEOUFNCE  NUfU'ER  ON  A 

LFM  CONTROL  CAINPFRR 

000  1 73 

IRO.  1 aI'EL  and  SI.O,  no,  = A6) 

INPFRR 

0 0 0 1 7 '1 

(,il  TO  999 

inpfrr 

00017b 

c 

IMpFRR 

000176 

?10 

WRITE  (OUTP,1?10J  ARn(X) .NTtRSTART 

INPFRR 

0 0 0 1 7 7 

1210 

rOR-MAT  (26H0lTt  Ration  NUMRLR  NT  FPOH  ,A6»7H  file  = 

T/|f 

inpfrr 

000176 

1 30H  DOFS  NOT  AGREE  WITH  RSTAHT  = I/lrP3H  FROM  IE 

M CONTROL 

CAHOT iOPFHR 
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000179 

CO  TU  '999 

IKREHR 

0001(10 

c 

IMPFRR 

OOOlHl 

98.0 

WRITE  (OUTRfl^tiO) 

IMPS 

INPfc'KW 

000  1(1^' 

H80 

FniniAT('52H0  ERROR 

IN  sunR.  tnperr,' 

ILLFGAL  ERROR  MFSSAOE  COOF.tlS)  INRFWR 

0001«i 

c 

INRI-iJR 

oooino 

999 

return 

INPKRR 

OOOHlb  • 

END 

INPFHR 
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a ELT  INPT»  1.760/127*  3Qo57 


000001 
000002 
OOOOOJ 
000000 
00000b 
000006 
000007 
0 0 0 0 0 fJ 
000009 
OOflOlO 
0000  1 1 
000012 
0000  1 3 
oooo  I 4 
0(10  0 1 b 
000016 
000017 
000016. 
000019 
000020 
000021 
000022 
000023 
000024 
00002b 
000026 
000027 
00002U 
000029 
('1)0030 
000031 
000032 
0000  <3 
000034 

oono'i'i 

000030 
000037 
000036 
000039 
000040 
0O0041 
0 0 00,42 
000043 
0 0 0044 
oono'ib 
000046 
00 00 4 7 
000046 
000049 
OOOO'lO 
0O0  0‘'  1 
OOOObR 
OOOO'^i 
000034 
OOOOS'J 

oooo'^o 
000037 
0 (j  0 0 3 li 


SUBROUtIHF  lN2T(IStGtIAc0l)TlCAMFR.lCKt’PW*ISIGXtlPASSr  INP 

1 InONftlFND)  ! . IPP 

C Il.'P 

C THIS  SUI'hODTIHE  ofTS  THE  NtXT  SFT  OF  RtCOROS  TO  PROCtSS  FROM  JHp 

■ c thf  Input  fius.  jnp 

C INP 

cnMH0M/S£f:rRU/C0UN4.iRfR4,IZ0Nt4t ISTKA4,ISUn4.ISfcG4.  ■ • SFGTRU 

1 ir.iPRI0R(6)ilSPWfPTf2)  ■ • 61 GTRU 

COHHUM/AUOUIS/COUNI »lRfc.Rl ilZUNE 1 f ISTRA 1 . ISUPl t ISfc  G1 . A(  (HI  J S 

1 IRlH(fl.2b)f  nnjAL  AdJUI^ 

' cnHHOH/CAPLRR/  rOIJNPf  IRE02.IZ0N£2,ISIPA2tlSli62»ISFG2»  C-AMFHR 

1 PW(3,4)  ,,if  HR(3.4)  »STGf-KR(5,4)  CAhFRR 

COHH(iN/rR('PW/COUU3t  1RFG3»  1 ZONE  3f  IS IRA3t  151)63.  CPoPR 

1 STAR!  C2,4)  ,FN0(2.4)  ,Sn(21  .E.RRC2.5)  CROPW 

inu’gcr  GTA'Rr.i-Hi'iSn.rRR  cpopr 

C()HMC)N/SlRf.X/r(ni.v3,  (KrG3,  I7nt)FbtZ!U3.2)  .ZSir.(3»2f6)  bU.Fx 

C ril  f UtFlnlllONS  AND  RFCORD  l.tNGTuS  FTiFS 

COMMON  /FIU-S  / FILFS 

1 str-io  fi serid.cropw  .LCRnpw.sunKsr .lsuhh  . acouis.uacr  mlfs 

? fCA)'sF  ,LrAMSF,r.AMt.RR,LCAHtR»CASF  .L'CASF  . Y E SOUT  . L Y t SO  FILFS 

3 .Sir.{.XT,LSlGl.X.YtStRK,LYtSLn.SF,CTRUtl  StOTR.CASDIS.LCASD  FILFS 

4 tll.P  ...OllTP  »!ACU  .LTACo  fCASOSF  .LFaSUS  FILLS 

IfJIF'OfH  SLRin  »C-’0)‘W  tSUt'HSl  tACuUlS.rA.'^SF  .CAmERR  .0  ASF  .YESOUT  FILKS 

1 rSIGl xT.YLSFRR.6f bTRu.CASDlS.UDlR  .TACU  .LASDsF  FILFS 

C ' FUFS 

COHHON/INOX/  INDEV<  U . I PO  1 NU200  1 ) . 1 PNT2  f 200  ll  ♦ J PLMD  , I PIN  JNDX 

COHHONVTArO/l'ifjl,  l)(4,  lp‘>)  , [m(^  TALO 

C ! LM  CUKTROL  CA'’D  iNPItl  DATA  LI  HCM 

COMMuM  /ILf'cH  / LINCFS 


I TITlf(IO)  .ICASF  .CliNTHY.NTRlAL.KSTART, IPRINT.STARIR. START/  LFMCM 
? .FliCiR  .EMDZ  .16TG  ,ICA«3  .lYFS  .IA(,0  .ILlASS.ISKT  .ISCC  LFMFM 

3 .ICAS2  .ICAS3  .IPRCAH.IPRYtS.iRRCAS.lCSESr.ICSLCW.ICSFSH.ICSLCC  LFfu.H 

4 , ICSeYM,  ICSf  sr.  iL.SfcAC.KStEDt  .RSEfcD2.RSLED3,R5Ftn4,KSLED5»R6Etn6  LFHCH 


5  .R5H  D7, 1CSF6T,  ILSFCO,  iCSEYS.  ICSLCU.  1C6FCD  UHOM 

DTME'NSfON  F;SLE(H7)  LFMCM 

DOUHLF  PKFCrsiUN  RSLFO  .HSEtPl  »RSbe'D2.RSEEI)3.RvStFD4,R6Et0b  , ’ LIHEM 

1 .RSf  t PP.RSlFD?  Li  flCM 

EOUIVALFNrt  ( RSFLP.RSFtni  ) LFMFH 

JRTF.Gri!  PSTARI.GTARlR.sTARfZ.LNDR  .ENDZ  Lt  MCH 

C Lfl-trM 

C'  CAMS  CONTROL  CARO  INPUT  DATA  CAMSCM 

COHMON/CAPSCM/  IMODF L , I HUH  I , I S I GEX . 1 5K I P . 1 T MAX . I RtP » I R INOf  CAHScH 

1 I(, r<OUP(3. 2,  Jb)-.HS(5, 2.3)  .C(3, 2.?), h(3. 2. 2)  CAHRCM 

RFAL  M$  • CAhSCM 

C CAHSC'-l 

C ARfuNtMT  LIST  FOR  FRROR  PROLFSSIMG  . APOLST 

" CDKMOM  /ARGLST/  - ARGLST 

1 KFRrS  .NFaTaL  .NPt'RRS.HARG  .AHRCIO)  APG!  ST 

DlHiNSjON  lARcnft)  ARl.l  ST 

EOUtVAiFNCE  ( lARG.APG  ) AF'OI  ST 

C ARIA  ST 

C srATlSTlCAt  information  FOR  u;h  stats 

COMMON  /STATS  / STATS 

1 IllR  .NSECIR.KCAHSM.NYLSR  .NRFC(7) fNCASCR.NCASDR  STaTS 

EDUIVALKYCt  ( NT.ntR  ) ' STATS 

c stats 

COWON/TRAI.NSA  CfluiJ7,lRt-.G7.  IZONt7.tSTRA7.I5UB7.  isfcr.7.  U>  AInS 

1 nK{M(4.2b)  . i ITOT.THMl  1,4,?b)  .TIfP(3?4.2lS)  .TVV(3.4.2b).  TRAINS 
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OOOOS9 

■ '1  TPTnU£tTI2lJLI)(0)  »TP£.ST(0)  » TPFKR.CO ) t T FRTuT  ( 3)  ♦ T H ( 3)  t T V ( 37  » 1 0 ( 5) 

TRAINS 

000060 

7 7 ZULU 

IRA  T Nil 

000061 

DTiir7(SlON  ITHA1N(129) 

TRAINS 

OOOOOfJ 

tnu7VA|.KHCt'a7HAlN,COUN7  7 

TRAINS 

0 0 0 0 /.  i 

30  CONTIMijF 

•INp 

000060 

lFnSFG.e7.0)  GO  70  lO 

JNP 

00006S 

irUF'FG't.eu.ENDR.Ann.TZnNFO.FO.fNDZ)  ItND=i 

INP 

000066 

Rf:AO(3Lr.TPU)C0UN«t  IREGO,  17UNtO,ISTHA6t  lSun4»lSt60t 

INP 

000067 

1 1T»  (IPHI(7R(7)  f I=l»67  t tSPKi  CP7  a)fl  = l f?) 

INP 

OOOOOtt 

C 

• 

lliP 

000069 

C 

■ CHECK  IF  OO'JE 

IMP 

000 070 

lF(EKn;,.fcn.o,ANO,coiiN/uMF..OHZ7ZZ)  go  to  in 

IMP 

000071 

ir(F6n/ .to.O,Ar,O.COUI^O.ro.4H7ZZZ7  GO  to  20 

IMP 

00  007c! 

IF  ( TEN’|).tO.0,At.in,CUUNO.FU.4MZ2ZZ)  GO  TO  21 

INP 

00007i  ■ 

IFaiFun.FtJ.  D.ANO.noEr.O.Kf  .EKOH.OR.IZONEO.NE.FNOZ) 

IMP 

000070 

1 .ANO.rUimil.!7t.4HZZZ7)  GO  TO  21 

INF 

00007‘i 

IF  a.OiiHO.L'O.OHZZZZ)  GO  10  20 

INP 

000076 

GO  Tu  lO 

IMP 

000077 

' C 

IMP 

00007A 

c 

ERROR  RFtURM  - RO  fcN(7  ZONE 

IMP 

000079 

21  COHTIMuF 

INP 

000060 

190>-ifc=2 

INP 

0 0 0 0 f.  1 

NARG=0 

INP 

000002 

CALL  FRP(!lES(4HCAM3»4HrNP7f2fO) 

IMP 

oooooi 

c 

INP 

OOOOPO 

c 

OONF  PHOgFSSINO 

jr..p 

oooonb 

20  CONIIDuf 

INP 

000066 

inoMLsi 

IMP 

000067 

RFTIIKN 

IMP 

000063 

c 

i 1 

IMP 

000069 

c 

CHLCK  IF  THAlNIffG  OR  OkOlwARY  SEGMtNTf  AND  BRANCH 

IMP 

000090 

10  CORTlMuF 

IMP 

000091 

c 

IMP 

000092 

c 

ACuHir>.  PASS  OR  SPECIAL  CASE  - ORDINARY  SEGMENT 

IMP 

0 00  09.1 

IF(IPASS,FO,0)  GO  10,200 

IKP 

OOOQOO 

c 

IMP 

00009b 

c 

TRAINING  Pass  - SKIP  OVF'K  ORDINARY  is 

IMP 

000096 

IFdPASS.FU.l.AND.IT.FO.n  GO  TO  50 

IMP 

000097 

IF(  tPASS.FO.l.ANO.n.f  0.0)  GO  TO  200 

IMP 

0O009U 

c 

_ 

IMP 

000099 

c 

ORDINARY  PASS 

IMP 

000  100 

IF(IPAsS.C0.2.AND,IT.FO.n  GU  TO  200 

IMP 

OOOlOl 

c 

IMP 

000102 

c 

ordinary  pass  - TRAINING  SEGMENTS  - WRITE  TO  OUTPUT  FTLE 

IMP 

OOO 1 05 

c 

GET  FROM  bCRATCM  FILF 

IMP 

000  1 00 

CAU  TsAVF(!sKG4tttT3A0) 

IMP 

0001  0b 

HPlTt (f AHSF7C0UH7» IHEG/i lZ0Nt7»ISTHA7,lSUB7.1SE07* 

IMP 

(10  0 10  6 

1 TPTRUFf  f riZULUU)  trPEsm)*TPFHR(n,I  = l*4) 

IMP 

00010/ 

NC  ANSP=NCAMS(?t  1 * 

IMP 

000103 

GO- TO  10  1 

IMP 

0001  09 

200  CONTlNiR 

IMP 

00011  0 

c 

IMP 

000  111 

c 

READ  ACnuTS.  FILL 

IMP 

000  112 

IF(IACOU.GT.O)  GO  TO  OOO 

IMP 

6 IJ  0 1 1 5 

Rt'AD(  A{:OUIS)(,0l)Nl . IREGl , I70NF  J » TSTRAl  t ISUBJ  t ISECl » 

IMP 

0 0 0 1 1 1| 

1 {(]KlN(l*J)tJ.ilf?b)dsltO)'flTUtAl  ’ , 

IMP 

0 0 0 n b 

c 

INP 

OOO  1 1 b 

c 

" HISSING  rFCOROC 

IMP 

0 0 0 117 

IARn(t)  = 6HAClJUIS 

IMP 

0 00  MH  : 

ir (roiiHi .fo.ohzzz/7  go  to  jio 

If.P 
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noo'i  IV 

Jir  (TSf'ol  .NE.lStCO)  GO  Tn  200 

IMP 

0001?0 

• IFCCOl'Nl  .FU.ilHZZZZ)  GO  TO  310 

INP 

0001?!  . 

• 

,•  GO  TO  900 

IMP 

noo  I?.*. 

c 

MISSING  R6C0RD  t'RROR  KliTURN 

IHP 

O00!?j 

c 

.IGP 

0001?'!  ' 

' 

310  contjnuf 

IMP 

dyni^j^ 

NARGM 

IMP 

OOO I ?6 

IMP 

0001?7 

CALL  H?HMrS(9HCAM3fOHTNRT»3»n  ■ 

R!P 

oonipo 

RMIIHN 

IMP 

000 i?v 

c 

. 

IMP 

OOP  MO 

c 

RFaO  CAfhRR  FlUt 

IMp 

OOOl-^  1 

'900  'CONT  iMUl’ 

IMP 

00013i! 

IF ( 3 AroU.t  E,0)NRtCCV)sNPtC(7)tl 

IMP 

000135 

If (tCAHlR.GT.O)  GO  10  500 

IMP 

0 0 0 1 <;  (i 

DO  /Ii0  T = 1 t« 

IMP 

0001 

- 

P'-/(lfJ)=t'T(4)/100. 

IMP 

000136 

I>5(?,I)=0. 

IMP 

()0(M  3/ 

f'VU  ?»  3 ) = 0, 

IMP 

n 0 0 1 3 0 

930  cniniMuf 

IMP 

000159 

DO  9iJ>  1=?,3 

IMP 

000300 

DO  9. >9  J=l,9 

IMP 

000101 

Uf  KRU  ,,l)rO. 

IMP 

00036c; 

S I Gt  rtR  < T t.J  ) = 0 . 

r.p 

OOOlOi 

939  COMflGuF 

IMP 

000300 

932  CORTImuF 

IMP 

0001  Ob 

9 30  cOI.TIWuF 

IMP 

000  1 /JO 

iFnopnn..tfi,2)  go  to  9?o 

IMP 

00030V 

Kf  AI/irAliLRincOUM^tlRtOrf,  170NE21  tSTKA<>,  18UR2f  lSL02f 

IMP 

000 100 

1 U(RWU»J),l  = l,i),(bFl<R(ItJ)  fSIOCRRCitJ;  »I=l»iI»TSKHf 

IMP 

0001 09 

1 ISKPl  1 J=1  »/j) 

IMP 

000  1 <10 

GO  TO  u»0 

IMP 

0001^3 

920  COHTll.'UF 

IMP 

000  3 1,; 

RFAD(rA03  RR)  COHN?* IRpU? 1 1 Z0Nr2 1 1 S TRAP t T SU82 1 T 5FC2 f 

IMP 

OOOlVi 

1 ( ( IskI'.  1=1  *91  »l1lLRR(lf  J3  »SI&LRHniJ)  f Jal  ,9) 

IMP 

000150 

990  COhTlMliF 

IMP 

000155  ■ 

IAHO( 1 )=6HCAhF  KH 

IMP 

000  1 56 

IF crouN?.nj.9!)/zzz)  go  to  3io 

IMP 

00015V 

IF(7.S9(;2.F'£.I!  ( 09)  GO  Tn  910  ' 

IMP 

000.156 

N9|  C(/!)=(iPEC(<')4l 

IMP 

000  157 

' c 

• 

IMP 

OOOIAO 

c 

READ  t,RMi>VJ  FRF, 

IMP 

d 0 0 1 />  1 

500  CORTINoF 

IMP 

00O16r2 

, 

IFUCHdPW.GT.O)  go  to  600 

RP 

OOOlOi 

IF  (TSI’ftl.FO.lSUIIO)'  GO  If)  600 

IMP 

000169 

REAn(fHnPW)C00N3tlRFG3»IZ0NFiflSTRA3iT5II63f 

IMP 

000165 

1 U (Start (TtJ)itNU(ItJ)rJ5tT9)tSO(I)t(tKR(TfJ)tJ=lt5))»Isl.2) 

IMP 

000166 

I ARG(  1 5 =5('i;Ru'’I 

IMP 

000167 

IF(COUN3.F11.9HtZ2Z)  GO  TO  ilO 

IMP 

000166 

IFnGU(i3,Rt,lSU69)  GO  Tn,  500 

IMP 

000169 

N)»triP)=uRtC(2ltr 

IMP 

000170 

■ 

60  0 COfjTlNuF 

IMP 

n 0 0 1 V 1 

IARf,(  I ) = 5liCR(iP./ 

IMP 

oooive 

c 

CHECK -IF  HO  OAlA  - WI N If R/SPK I NG 

IMP 

000173 

IKUCP()Prt.LF  .O.ANO.Sf  AKTU  + 1SPWf2),F0,0.)  GO  TO  ilO 

IMP 

000170 

c 

' 

IMP 

000175 

■ c 

HFAI)  Sir-i  XI  Flu- 

IMP 

000176 

irtiSK.x.r.T.d)  CO  in  700 

IMP 

000177 

J(  nZOMF  5.3.0. UOtlfo)  GO  TO  700 

pip 

000176 

un  692 

INP 
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00017V 

zn(TTt)="i. 

INP 

0 0 0 1 ft  0 

DO  690  J=lf2 

IMP 

000 Ifll 

DO  696  K=1j6 

■ INP 

000 

ZSIR(I,J*K)=0. 

INP 

oooinj 

69b 

CDtlTIMUf 

■ INP 

0001 flU 

6«0 

CfNTlNljk 

INP 

oooifli} 

■ ■ 692 

CONTlNur 

IMP 

0001K6 

690 

continue 

IMP 

oooifi/ 

IF  (lMOl>rL.fiO,,2)  GO  TO  610 

INP 

OOOlflC 

RFAO(?iC.l.xncOUWli*  IRERS,1Z0NES» 

UP 

OOOIBV 

1 U/:f’(I»J)tJ=i»2)«((2STGatJtK)  tKslf6)»J  = lt2)fIal  *3) 

INP 

OO0190 

GO  TO  6^0 

U-'P 

oooivi 

■ ■■■  '■  " “610 

CONTI MuK  ■ . ' ' ' 

INP 

oooiva 

\ 

HlAOlSlObXncOUNStlREGS.UOMtSi 

INP 

OOOlOi 

1 (T3Kptl  = lt92)  1 (7.!(t,J)iJ=l»2I»aZ5ia(If  JtK)»K=ltb)tJ=l«2) 

. INP 

000199 

620 

CONTINUE 

u;p 

00019*.} 

I/iKU(  1 >=')U'SlGEX 

UJP 

OOOl'M) 

' 

lF(rOMf,S.H).9HZ72Z)  GO  TO  310 

INP 

00019/ 

If- nZONi  b.Ht.UONe«)  GO  TO  690 

INP 

000191S 

DO  639  1=1 ,3 

INP 

000199 

2I'(Trl)=Znn,l)  + l. 

INP 

000,100 

COnTI'UIF 

INP 

OOOdO  1 

f|HtC(6)=NIfLC(6)  + I 

INP 

000202 

700 

conunuf- 

INp 

ooo,;o3 

■ ’C 

IMP 

000209 

C CHECK  RAMr.E  ON  PT(?)  • ‘ 

INP 

00020S 

lOONIrO  ! 

INP 

00020b 

IRPl  (21  »PW(2f  IWJND)  .1,T.(PT(2)-1PT{  n-lOO.)) 

INP 

ooo,;o7 

1 PTl?)  = (luO.-PT(in/(lOO.-Ph(2.IWIND)>  ‘ 

IMP 

000206 

1E(P1  (2)<*PH(2»1HIND5.GT.PT(1))  P I (2)  = PT  ( 1 ) /PHC2t  IWINOl 

INp 

000209 

Hr  niHM 

IMP 

000210 

fc.NO 

INP 
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000001 

oooooa 

oooooi 

OOOUO't 
000005 
000006 
000007 
ooooort 
000009 
0000  10 
00001  1 
0000  1 2 
OOOOli 
00001  « 
000015 
000016 
000017 
OOOOlO 
000019 
0000?0 
OOOOPl 
0000?2 
000025 
000020 
000025 
000026 
000027 
000026 
000029 
0 0 0 0 0 
0000'^  1 
000052 
,000055 
000054 
000(1  ib 
000056 
000057 
000056 
0000  59 
OOOO40 

00004  1 
000042 
000045 
000044 
000045 
000046 
000047 
000048 
000049 
000050 
00  0 0')  1 
0.0  0 052 

00005  5 
000054 
000055 
000056 
000057 
0OOO56 


suhroutihe  input  input 

C ■ RhAoS  AND  ChFCKS  LFM  CONTROL  CARO  INPUT  INPUT 

C AL60  CALL  ROUTINES  To  READ  CONTROL  CARO  INPUT  FOR  CAMS  AND  CAS.lMpUT 

C • INPUT 

C • ■ COPmOH  blOCK  DCHNITIONS  INpUf 

C ARnulUNT  LIST  FOR  fRROR  .PROCFSSINO  Allol  ST 

COMMON  /AhO.LST/  ' AROLST 

1  NLPhS  iNFaIaI »mperrs,naro  »ARG(10>  arolst 

OTMlNSiON  lARt.nO)  ARoLST 

COUtVAl.fNn  { lARGtARG  ) ■ AR61  ST 

■'  C ■ AROIST 

C FILE  OtFlNlTIONb  AND  RECORD  LENGTHS  MLFS 

COMMON  7HI  ES  / ' • FILES 

1 SEOil)  ,LSLMOtn<OPW  ,LCR0PU,SU8HSTfLSUBH  ♦ACOUIStLACt)  ElLFS 

2 tCAPsE  tL'CAMSFfCAMLRH.LCAMERtCASF  tLC.ASF  » YESOUT  tLYt.SO  MLFS 

3 »S10EXI,LSl6LX,YtStRK,LYtSERfSEUTI'U*LSLR1RfCASDlS.LCASO  F UF8 

4 »INP  ,OUTP  fTACU  ,LTACU  tCASUSF . LC ASDS  FILES 

INTFOE'R  SEOID  fCRoPW  t SUHHST  t ACUUIS  » C AMSF  *CAHrRR»CASE  *YESOUT  FILFS 

1 »SU.FxT  tYLSERRtSrulKUtCASDiSfOUIP  ,TACU  tCASPSF  Hi  FS 

C MlFS 

C I EH  control  rARD'lNPur  data  lintm 

COMMON  71 LMCM  / LFmCM 

1 TITlE(IO)-  tICASF  ,CllNTRYf«TRIALtRSTART, IPRlNT.STARTRtSTARTZ  LFMCM 

2 »FNDR  rENo?  'tlSIG  ,ICA'1S  tlYFS  tIACO  * I CL  ASS . 1 5E  X T »TSCL  LFMCM 

3 iTLAS?  .ICaS5  1 1 I'RC  AM , I PRYEP  » I PRL  AS  H CSESC.  * I CSECh  i 1 C SF  3U  1 1 CSECE  LFMCM 

4 tTCSrYM,ICSF$F.  ICSLaC.RSEEDI  TRSFED2.Hr.EFD3fRSEED4,RStEU5,RSEE06  LFMCM 

5 tRSf  1 tW,  ir.Sl  ST.  TCSF  CUtlCSfYS,  rCSlTU.  ICSFCD  lfmcm 

OTMFNSjCN  RSFEIH7J  LFMCM 

OOUtiLF  PKrciSlUM  HSEFD  » HSEEO 1 » RSEE  U2  . RSEE05  . RSEE  D«  . RS  EEOS  lFMCm 

■ T tPSEEObiRSErD?  ^ lfmcm 

EDUTVAlFMCE  ( RSLED.RSfEDI  ) LFM«'M 

INTltER  PSTaRT  .STaRTR.RTARTZ.ENDR  .FNDZ  " LFmCH 

C . Ll.MCM 

C ■ pare  eject  CONTROL  PARAMEIERS  FOR  LEM  PAGFCM 

COMMON  /PAOECMy  PA(,FCM 

I NPAgE  .NLINe’  .MXl INE.NSTTL  .SUBTTL(IO)  , PAOFCM 

c paofcm 

C ■ INPUT 

C I OCAl  VAR  I Anns  IfPUt 

c LUL  = Control  card  label  and  seouence  number  in  as  format  input 

REAL  L»L*U1L1  * INPUT 

C ■ ' ■ INPUT 

C HMkACF  ...  CALL  INPUT  INPUT 

C input  is  called  from  the  LEM  DRIVER  INPUT 

C INPUT 

C SUTirOUTINES  called  • INPUT 

C ' EJFcT*  ERRMES,  IHPCHK.  camsin.  casin  input 

C ■ input 

c j .;p(|  j 

C input 

C ' IF'PUT 

C TFEAd  ethst  LFM  control  card  . input 

RFAD  tiNP.n  TiriLtLOLl  . INPUT 

1 FORMAT  noA6.!4XtA6)  ^ ' ilN'Ul 

C ' INPUT 

C read  SFCOND  I LM  CONTROL  CARD  UtpilT 

RFAi)  (IEP.2)  ICASE  .CUNTRY.NIRIAL.HSTART.IPRINT.STARTR.STARTZ  JOl'UT 

,1  .FNDH.FN'l)/»!ST(..J('AKS,IYES.lArOi.KLASS,lSFX7..ISCC,ICAS2.ICAr.5  Iliplll 
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000059 

OOOOOO 

OOOOM 

OOOOhi 

OOOO^'i 

oono^’O 

OOOOO'j 
OU0006 
000007 
0 0 0 0 0 0 
000009 
000070 
000071 
000072 
OOOO/J 

oono  70 

000075 
00 II 0 70 
000077 
0001)70 
000079 

noocoo 

oooooi 

OOOOP.2 

OOOOA3 

OOOOliO 

000005 

000006 

oooon/ 

OOOOftO 
OOOOIW 
0(10090 
000091 
000092 
000093 
000090 
000 095 
000096 
nooQ97 
000090 
000099 
000100 
000101 
000102 
000103 
000104 
000105 
000106 
000107 
ooomo 

000109 
ooo  n 0 
0(10  1 1 1 
0 0 01)2 
000113 
000114 
0001)5 
000116 
000  1 1 7 
000  11  0 


2  »TPHC''H»lPHYtS»lHHCA£»tLt1L  IMPM7 

2 FOKMAT  (I«»lXtA6«214, 13, 414, 1213, A6)  IKPUT 

C • INPUT 

C . CHfCX  I Ann  AN!)  SEoUFUCt  NUHHtR  OF  FIPST  CONTMOL  CAHO.  INPUT 

IF  ( L('.!  1 .t.O.  OliI.CH  01  ) 00  I»  200  INpUf 

APOtnc  LUU  INPUT 

NAKO=  1 ‘ If'PUr 

CALL  fl)PHfS  (3HL£.M,5HINPUT,20i  n INPUT 

C INPUT 

200  NPAr,L=  0 . input 

CALL  P’jFCT  (17)  JN)»iIt 

WHlTt  (OOTP.IO)  JPPUI 

'10  FOKMAT  (/  20X,45UI.  FH  INPUT  CON.  TROL  CAROS/)  INPUT 

wRITt  (OUTP.ll)  TITLFflbH  INPUT 

It  FOKMAT  (/7H  TITLF/PX, 10A6, )4X,A6)  INPUT 

KRITL  (OUTP,)?)  irASE,C(UiTRY,KTRIAL»KSTART,TPRJNT,5TARTRtSTAKTZ  llPUT 

1 ,rN(,IMLNlj'7,  I&1  li.  ICAJ-'S,  IVLS?  lAFB,  ICLAS5,  TSFXT  , I6CC,  ICA32*  1CA53  INPUT 

2 ,TP!  fAM,  If'KVr  S,  JPKC.\5,L»L  IK'IJI  . 

12  FOKMAT ( 1 U7h01CASh  COIINTHY  NtKIAL  RSIAKT  IPKINT  STARTR  STAHIZINPUT 

1 ENDK  LnU7  ISTI’.  ICAmS  IYFS  IACU  ICIASS  I5FXT  / INPUT 

2 Z6,3XtA6Tl/f IS,I7Ti9Tltt,l7,)6fl5,l6,l7,T6,17,T7/  INPUT 

3 5211  ISCL  KA62  ICAS3  IPPCAIl  IPRVh'S  IPKCAo  LAUEL/  INpilT 

4 I5.l6f I7,I8»1A,I«,4X,A6T  INpil? 

C ruFcX.I  Alitl.  AMO  SLOUFNCE  MUMMEK  OF  SECOND  CONTKUL  CAPU  UPUT 

IF  ( I Ml  .bO.  6HLF.H  0?  ) UO  TO  301)  lupUl 

- AKG(1)=  LUL  INPUT 

NAKfic  1 -INPUT 

CALI  FRKMFS  (3HLbM,')HTKPUT,20!  n IPpUI 

C I!)'U1 

C 9|  Ad  TUIKl)  CONTROL  CARD  ' INPUT 

• 300  read  (i(-;p,3)  irSF6r.,itSECw,KSFSH,ICSECE,irSEYM,ICSeSb,lCSEAC  INPUT 
t T ILSUS  r , irst'cn,  ICSbVS  ,)-tKbEl)l  »RSFt02<LHL  INPUT 

3 fOP-lAT  ( I014,SX,2'n2.n,2X,A6)  ll.’PUT 

WRITE  cf>'HP,l3)  irSFSn,TCSFCH,ir:sESH,ICS£Ct:,irsFYM,rCSESt»lCSFAC  INPUT 

1 trcSt;>l,irsEC0tlCSLyS,KSEfl)l,»SEED2,H)L  INPUT 

13  FORI-AT  (55M01CSt$r.  ICSFCW  K.Sf  SH  ICSECE  IFSEYM  ICSESE  iCSEAf.lMpUT 

1 ,24(1  irsisT  Ksitn  irsfYS/lo.Rty/  . input 

1 8X,6M«SbF:ul , I iX,6)(RSrbn2,  1 OX  i 5nu  ABrL/202  I . 12,iX  , A6)  INPUT 

C fUFcK  I A PEL  AND  SF.DUT'NCL  nUMMLR  OF  THIRD  CONTROL  CARD  ' IM’llT 

IF  ( I 111  .LD.  Mll.FU  03  ) GO  TU  400  INPUT 

A9U(n=  LRL  .*  INPUT 

NAr((;=  1 INlUIT 

. CALL  FhRH(S  (3Ml.bH,5HlNpUT,20,l)  INPUT 

C INPUT 

c rlad  fourth  cuutroi  faro  input 

400  RFAD  (1NP,4)  RStroS  ,RSFbD4,RSEF05iRS£En6,RS£ED7,LUL  INPUT 

4 FORMAT  (5D12.n, i OV, A6>  INPUT 

WRITF  (UUTP,1“4)  RSblyTrR5E£l)4,RSEEOS,RSEEn6,RSEF07*L!3L  ' INPUT 

14  ' FORMAT  (/RX,6HK?EFu3,14x,6HRSFEi)4,14x,6HRSEE:05»l4X96hRSet06tl4X  INPUT 

t ,6UI.-<iFtl'>7,lOXt5HLA!irt./5D20,)2»3X,A6)  INPUT 

• C DiFcK  I AMFL  AMO  StOUFNCF  NUMOf.R  OF  FOURTH  CONTROl  CARO  lUPUl 

IF  ( 1 1,1  .tn,  6KLrH  Ofl  ) GO  TO  lOuO  INPUT 

APG(n=  LP.L  INlMi; 

NARGii  1 • INPUT 

CAL!  IrRMKS  (iMLLM,5M.lNPUT,20«  1)  (NPUl 

C , ' INF>IIT 

C FHKcK  I eh  control  rARO''oATA  FOR  FRRURS.  ALSO  CHECK  INPUT  F ILF  INPUT 

C MEAdFRS.  . INPUT 

lOOO  CAL'l  TmF'CHK  . • IFipUT 

C , ' INPUT 
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0001  J</ 

c 

RLA6  and  check  cams  control  CAROS 

IMROT 

OOOlPO 

CALL  CaHSIN 

INPUT 

noolPi  ' 

c 

read  and  check  CAS  Control  cards 

input 

oooi?^: 

CALL  CaSIM 

input 

0001?3 

c 

input 

OOO  t?4 

; 

CALI  RARER  (S) 

INPUT 

0001?b 

! 

WRITE  (OUTPfPO)  NLHRSjNEATAL 

INPUT 

ooni?6 

?0  ‘ 

FORMAT  (//SX,ISt«3h  NONFAIAL  ERRORS  DETECTED  ON 

control  cards// 

INPUT 

0001P7 

J 

1 

t SX»T5»«3H  fatal  errors  detected  UN  CONTROL 

CARDS) 

INPUT 

0(10  IPO 

000 

RF'TOKM 

INPUT 

OOOlP'O 

• i 
..  j.. 

END 

if  PUT 
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FOR, 


C 

c 


IS  LEM 
PROGRAM  LEM 

LEM 

MAIM  DRIVER  FOR  LACIE  ERROR  MODEL  (LEM)  LEM 

LEM 

CODED  BY  J.  R.  TAYLORt  JANUARY  1976  LEM 

LEM 

COMMON  BLOCK  DEFINITIONS  LEM 

ARGUMENT  LIST  FOR  ERROR  PROCESSING  ARGLST 

COMMON  /ARGLST/  , ARGLST 

1 NERRS  ,NFATAL»NPERRS,NARG  »ARG(10)  ARGLST 

DIMENSION  lARG(lO)'  ARGLST 

EQUIVALENCE  ( IARG,ARG  ) ' ARGLST 

ARGLST 

CAMS  CONTROL'  CARD  INPUT  DATA  CAMSCM 

COMM ON/ cam SCM/  I MODEL  » I MULT  I tISlGEX,lSKlP,ITMAX»IREP,IWIND,  CAMSCM 

1  IGROUPO,2,15)  ,MS(3,2,3),G(3t2r2)  ,H(‘3,2,21  CAMSCM 

REAL  MS  ■ ' CAMSCM 

CAMSCM 

CAS  CONTROL  CARO  INPUT  DATA  AND  CONSTANTS  CASCM 

COMMON  /CASCM  / CASCM 

1 AREACFtYCF  ,PRDCF  ,APRUTS(4»2)  ,PPRUTS{5,2)  ,YPRUTS(3,2)  CASCM 

2 , AREAPS  ,S2MAX  ,NHISTY,HH  ,TOPT  , AUN I TS , D I S TFF , BW IND ( 4 ) CASCM 

3 ,WPRI0R(4)  ,APREP  ,IPRD(3,14)  , NPDAT'E,  PRDATE(  14.)  CASCM 

INTEGER  HH,  TOPT,  AON  I T S ,D I S T FF , BW I ND , W P R 1 0 R , AP R EP , PRDATE  CASCM 

CASCM 

DATA  BLOCK  FOR  CAS  CUMULATIVE  FILE  CASCUM 

CAS  data  SETS  14,  15»  16,  AND  17  CASCUM 

COMMON  /CASCUM/  CASCUM 

1 CASCUM(32),  BUFFR(504)  . CASCUM 

DIMENSION  ICASC(32),  DSET14{22),  DS ET 1 5 ( 22 ) , DS ET 16 ( 2 2 ) CASCUM 

1 fDSETl7(28) 

EQUIVALENCE  ( ICASC, CASCUM  ) CASCUM 

EQUIVALENCE  ( OSET] 4, DSET15 , DSET16, DSET17 , CASCUM ( 5 ) ) CASCUM 

1 , ( SQAERStSOAERZ ,SQAERR» SOAERC » CASCUM ( 24)  ) , CASCUM 

2 t { SQPERS,SOPERZ,SOPERR,SOPERC,CASCUM(25)  ) CASCUM 

3 , ( SQYERS,SOYERZ,SQYERRtSQYERC,CASCUM( 26)  ) CASCUM 

CASCUM 

DATA  BLOCK  FOR  CAS  D ISTR I BUI  ION  FILE  (DATA  SET  19)  CASDSB 

DIMENSION  CASDSB(303)  CASDSB 

EQUIVALENCE  ( CASDSB,  BUFFR  ) CASDSB 
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DIMENSION  ICASD(303)»  HWA2K(60)»  WAKNEY{60)t  PIK(60)  CASDSB 

EDUIVALENCE  ( I C ASD ♦ HW A2K , C ASD S B ),  ( WARN EY , C AS DS 8 { 61 ) ) CASDSB 

1 , ( PIKrCASOSB( 121  ) ) ■ CASDSB 

CASDSB 

FLAGS  AND  CQUNTE^S  FOR  CAS  SIMULATOR  LEM 

.(  CHECK  LISTING 'of  CAS  FOR  PROPER  LENGTH  OF  COMMON  BLOCK  ) LEM 

COMMON  /CASFLG/  LEM 

1 CASFLG(40)  LEM 

LEM 

CONTROL  PARAMETERS  FOR  LEM  PROGRAM  ' CNTRL 

COMMON  /CNTRL  / . CNTRL 

1 PKIMTF»NSTART»SEEb( 7 ) CNTRL 

INTEGER  PRINTF  CNTRL 

DOUBLE  PRECISION  SEED  CNTRL 

CNTRL 

CONSTANT  QUANTITIES  FOR  LEM  PROGRAM  . CONST 

COMMON  /CONST  / CONST 

1 NTRMX  ,MAXR  ,MAXZ  , I MXSEG, ENDF I L » I T SF G CONST 

CONST 

file  DEFINITIONS  AND  RECORD  LENGTHS  ' FILES 

COMMON  /FILES  / FILES 

1 SEGID  »LSEGID,CR0PW  , LCROPW, SUBHS T , L SUBH  ,ACOUlStLACO  FILES 

2 tCAMSF  ,LCAMSF,CAMERR,LCAMER tCASF  ,LCASF  , YE SOUT , LY ESO  FILES 

3 ,S1GEXT»LSIGEX,YFSERR,LYESER» SEGTRUtLSEGTR,CASDlS,LCASD  FILES 

4 ,INP  ,OUTP  ,TACQ  tLTACO  rCASDSF tLCASDS  FILES 

INTEGER  SEGID  ,CROPW  , SUBHST , ACOU I S » CAMSF  ,CAMERR,CASF  »YESOUT  FILES 

1 ,s igext,yfserr,segtku»casdiStOutp  ,taco  tCASDSF  files 

FILES 

INDEX  RECORD  FOR  CAS  CUMULATIVE  FILE  (CASE)  IXCASF 

COMMON  /IXCASF/  IXCASF 

1 IXCASF! 1 ) tLIXCAS 

' vr  ASF 

INDEX  RECORD  FOR  CAS  DISTRIBUTION  FILE  TXDISF 

COMMON  /ixniSF/  ixnisF 

1 IXDISF(1),LIXDIS 

NOTE...  506  ONLY  ALLOWS  UP  TO  8 PREDICTION  POINTS  INCLUDING  IXDISF 

BIOWINDDWS  { 506  = 1 + 1 + 8463.  INDEX  + HEADER  + 8 PRED.  PTS.) IXDISF 

IXDISF 

INDEX  RECORD  FOR  INTERMEDIATE  SUBSTRATA  HISTORICAL  DATA  FILE  IXSUBH 
COMMON  /IXSUBH/  - IXSUBH 

1 LIXSSH. IXSUBH! I ) ' MODI 
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C 

C 


c 

c 


CUMMUN/FILESl/ 

1ISUBH2tLSUBH2 tMXCLSS 

LEM  CONTROL  CARD  INPUT  DATA 
COMMON  /LEMCM  / . 

1 TITLE(IO)  ,ICASE  ♦ CUNTR Y, NTR I AL , RST ART, I PR  I NT , STA RTR , STARTZ 

2 ,ENDR  ,EIMDZ  ,ISTG  ,ICAMS  ,IYES  tIACO  , I CLASS , I S EXT  ,ISCC 

3 ,ICAS2  *ICAS3  , I PRCAM , I PRYES , I PRCA S , I C SE SG, I CSECW, I CS ESH, I CS EC E 

4 , ICSEYM , ICSESE, ICSEAC,RSEED1 ,RSEE02 ,RS6ED3,RSEED4,RSEED5 ,RSEED6 

5 ,RSE£D7, ICSEST, ICSECO, ICSEYS, JCSECU, ICSECD 
DIMENSION  RSEE0(7) 

DOUBLE  PRECISION  RSEED  , RSEEOl, RSEED2, R5EED3 , RSEED4, RSEED5 
1 ,RSEGD6 tRSEEDT 
EQUIVALENCE  ( KSEFD,RSEED1  ) 

INTEGER  RSTART ,STARTR,STARTZ,ENDR  ,ENDZ 

PAGE  EJECT  CONTROL  PARAMETERS  FOR  LEM 
COMMON  /PAGECM/ 

1 NPAGE  rNLINE  , M XL  IN E , NS  I TL  ,SUBTTL(lO) 

STATISTICAL  INFORMATION  FOR  LEM 
COMMON  /STATS  / 

1 ITER  ,MSEGTR,NCAMSR,MYESR  , MRE C ( 7 ) , NC ASCR , NC AS DR 
EQUIVALENCE  ( NT,  ITER  ) 

YIELD  DATA  FROM  YESOUT  FILE 
COMMON  /YESDTA/ 

1 YSTR  ,IZPRDn(6)  ,YSCI(6)  ,VSYCI(6) 

2 ,RDYES  ,NYESPP 
INTEGER  ROVES 


LOCAL  VARIABLES 

I = INDEX  IN  MONTE  CARLO  DO  LOOP 

LINKAGE  ...  LEM  IS  CALLED  DIRECTLY  BY  THE  OPERATING  SYSTEM 
SUBROUTINES  USFD  ... 

START  , INPUT  , ERRMES,  INIT  , ERRMC  , SETPRF,  STG  ,CAMS 
YES  , CAS’  , WRAPlJP 


IXSUBH 

FILESI 

FILESl 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

LEMCM 

PAGECM 

PAGECM 

PAGECM 

PAGECM 

STATS 

SI  ATS 

STATS 

STATS 

STATS 

YESDTA 

YESDTA 

YESDTA 

YESDTA 

YESDTA 

YESDTA 

LEM 

LEM 

LEM 

LEM 

LEM 

LEM 

LEM 

I.EM 

LEM 

LEM 
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INITIALIZE  STORAGEt  FLAGS,  ETC.  LEM 

CALL  RANACF(4, 0,0, OtOrOtO). 

CALL  RANACF { 14,0,0,0, 0,0,0  ) 

CALL  RAMACF(  15,0',0,0,0,0,0) 

CALL  KANACF ( 16,0,0,0, 0,0, ‘O  ) 

CALL  START  LEM 

LEM 

READ  AND  CHECK  ALL  CONTROL  CARO  DATA  LEM 

CALL  INPUT  ' LEM 

LEM 

CHECK  FOR  FATAL  ERRORS  LEM 

IF  ( MFATAL  .NE.  0 ) CALL  ERRMES  ( 3HLEM, 3HLEM, 99 , 2 ) ' LEM 

LEM 

PERFORM  INITIALIZATION  TASKS  (INITIALIZE  RANDOM  MO.  SEEDS)  LEM 
CALL  INIT  LEM 

LEM 


MONTE  CARLO  LOOP  LEM 

NSTART=  RSTART  + 1 LEM 

DO  500  I=NSTART, NTRIAL  ■ LEM 

ITER=  I LEM 

ERROR  MODEL  CONTROL  - SET  RANDOM  NO.  SEED  FOR  EACH  ERROR  SOURCELEM 
CALL  ERRMC  ' LEM 

LEM 

TEST  SEGMENT  TRUTH  FLAG  LEM 

IF  { ICAMS  .EO.  2 ) GO  TO  300  LEM 

IF  ( ICAMS  .NE.  0 .AND.  ITER  .GT.  I ) GO  TO  300  LEM 

IF  { ISTG  .F(0.  0 ) GO  TO  120  LEM 

IF  ( ISTG  - 2 ) 110,200,110  LEM 

SEGMENT  TRUTH  FLAG  = 1 OR  3.  CALL  SEGMENT  TRUTH  GENERATOR  ONLY  LEM 
ON  THE  FIRST  ITERATION.  LEM 

110  IF  ( ITER  .GT.  1 ) GO  TO  200  LEM 

C SET" PRINT  FLAG  (PKINTF)  FOR  STG  LEM 

120  CALL  SETPRF  (IPRINT)  LEM 

C CALL  segment  -TRUTH  GENERATOR  LEM 

CALL  STG  LEM 

IF  ( NFATAL  .NE.  0 ) GO  TO  999  LEM 

C ■ LEM 

C TEST  CAMS  ERROR  FLAG  LEM 
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200  IF  { ICAMS  .EO.  0 ) GO  TO  220'  L6M 

IF  ( ICAMS  - 2 ) 210,300,210  LEM 

C CAMS  ERROR  FLAG  = I OR  3 . CALL  CAMS  ONLY  ON  THE  FIRST  ITERATIONLEM 

210.  IF  ( ITER  .GT.  1 ) GO  TO  300  LEM 

C SET  PRINT  flag  (PRIMTF)  FOR  CAMS  • LEM 

220  CALL  SETPKF  (IPRCAM)  LEM 

CALL  CAMS  LEM 

IF  ( NFATAL  .NE.  0 ) GO  TO  999  LEM 

LEM 

TEST  YES  ERROR  FLAG  LEM 

300  IF  ( lYES  .EO.  0 ) GO  TO  320  . ‘ LEM 

IF  ( lYES  - 2 ) 310,400,310  LEM 

C YES  ERROR  FLAG  = 1 OR  3.  CALL  YES  ONLY  ON  THE  FIRST  ITERATION  LEM 

■ 310  IF  ( ITER  .GT.  1 ) GO  TO  400  LEM 

C SET  PRINT  FLAG  (PRINTF)  FOR  YES  LEM 

320  CALL  SETPRF  (IPRYES)  LEM 

CALL  YES  LEM 

IF  { NFATAL  -NE.  0 ) GO  TO  999  LEM 

C LEM 

C SET  PRINT  FLAG  (PRINTF)  FOR  CAS  LEM 

400  CALL  SETPRF  (IPRCAS)  LEM 

CALL  CAS  LEM 

IF  ( NFATAL  .NE . 0 ) GO  TO  999  LEM 

C END  OF  MONTE  CARLO  LOOP  . LEM 

500  CONTINUE  ‘ LEM 

•C  • LEM 

e END  OF  Job.  print  program  status  at  the  end  of  the  job.  ' LEM 

CALL  WRAPUP  LEM 

STOP  LEM 

C LEM 

999  CALL  ERRMES  ( 3HLEM i 3HLEM ,99 , 0 ) LEM 

STOP  I LEM 

END  OEM 
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000001 

SUBRUUTTNF  lFPAfFU)A»LMn»LYR»Al.FGMiOAYS) 

LEPA 

000002 

c 

. . 

LF'PA 

ooooni 

c 

MODUir  - FiLFPA 

LFPA 

000000 

c 

0CT013FK  ii  1974 

LTPA 

ooooos 

■ ■ - c 

Lf  PA 

000006 

c 

1 f PA 

000007 

c 

.JUNE.  26>lo73 

LFPA 

oooooo 

c 

LFPA 

000009 

c 

module:  pplfpa  - point  target 

PERFORMANCE 

PREDICTOR 

LI  PA 

000010 

c 

LFPA 

0000  1 1 

c 

OlVfcN  OAY»HnNTH»YFAR  - SUflU. 

LFPA 

RETURNS  IH£  RIGHf  ASCENSION  OF 

LFPA 

000012 

< c 

GREENWICH  AT  MIDNIGHT  OF  A GIVEN  DAY 

LFPA 

0OO01  i 

c 

LFPA 

0000  1 0 

c 

PEI- FHEnEE  HPOCll  IS  0 HOUR 

lJANl°bO 

LFPA 

0000  lb 

UAIA  RaHIA.I  /57.29b7!)/ 

LEpA 

ooool  6 

c 

Lf  PA 

0000  1 7 

c 

COMPUTE  DAYS  IN  KILL  YtAKS 

from 

EPOCH 

10  LYR 

1 FPA 

000010 

c 

DAYS  To.  1J-|N1961  IS  <t70tt. 

LF  FA 

000019 

c 

LFPA 

000020 

DAYS  = <I7'I«. 

I.F  HA- 

0000? 1 

c 

MOIF  — lYR  'IUST  Hh  GREaTFR 

than 

OR  EQUAL  10  (19)69 

LF  PA 

0000?2 

LASTYPsl  YR-1 

Lf  PA 

OOOOP5 

00  ?0  i-6lf LASTYh  ■ 

LFPA 

00002'! 

i 

KHl-.HO  = Hl'l)KT-60)t<l) 

LFPA 

oooopb 

lF(KP|-.Mi..r-T.O)  GO  10  10 

1 FPA 

0 0 0 0 ? (> 

0AYS  = |iAYSti66 

Lf  PA 

000027 

1,0  TO  20 

U PA 

0 0 0 0 ? 0 

10 

0AYS  = I)aYS  + 365 

LI  PA 

000029 

?0 

COmTIHuF 

LF  PA 

oono  10 

IPlI  nn-1 ) 10 r 90, 30 

LFPA 

ooooil 

30 

IFQ  Mf'-?)60,b0,60 

LFPA- 

oooo;i2 

<10 

0AY!,  = 1>aY.‘>  + FI  da-k 

LFPA 

O0rto3i 

J 

on  TO  270 

LFPA 

000010 

50 

OAYS=nAVS+FLDA+10, 

LFPA 

00001b 

G'l  TO  2/0 

1 rpA 

000016 

60 

KDLI  =PoDKLYh-60)  ,<0  ■ 

Lf  PA 

000017 

IF(kdfl.gt.O)  go  to  70 

LFPA 

OOOOIIi 

OAYSspAYSfb'i. 

Lf  PA 

000019 

on  TO  RO 

Lf'PA 

OOOO'tO 

70 

DAY.1  = (lATS  + bH. 

LFPA 

oooo'll 

no 

IF(lHri-3)  270,170,90 

LFPA 

0 0 0 0 « 2 

90 

IKlMP-bJ  lf<o'»  190, 100  ' 

LFPA 

OOOO'li 

100 

irUHfi-7)  21'0, 210,110 

1 FPA 

oooooo 

* 

110 

IKLMG-9)  220»21O,l?0 

LFPA 

00  00 'lb 

l?o 

IF(I  KO-l  1)2110,210,260 

Lf  PA 

OOOO'lO 

170 

dayi=i>ays,fi  da 

Lf  PA 

0 0 0007 

GO  TO  270 

LFPA' 

OOOO'lH 

mo 

OAYS  = nAYS  + FU)A+3U  . 

LFPA 

000C09 

GO  TO  ?70 

LFPA 

nooo'io 

190 

DAY,''.  = DAYStFI.DA  + 61  . 

LFPA 

O0  00''l 

G'l  TO  2/0 

Lf  PA 

200 

OAYS  = OaYS4KDA  + 92, 

Lf  PA 

OOOOM 

GO  TO  2/0 

LFPA 

OOOOI'I 

210 

0AYS  = l'AYStFt.0Atl22, 

Lf  pA 

OOOObb 

GO  TO  2'/0 

LFPA 

oono'16 

220 

UAYr>  = rAYS4Ft.OA4l53, 

LFPA 

0 0 0 0 '■>  7 

on  TO  2/0 

LFPA 

OOOO^O 

210 

days=iiays+h.da<  1»<I. 

l.f  PA 
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LFPA 

lf'pa 
trpA 
Lr  PA 
LFPA 
Lf  PA 
bFPA 
Lf  PA 
l.rpA 
LPPA 
LFPA 
l.f  PA 
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OODOOl 

SDBRUUTINF  HuLT!{TYP(- ,SFAS0N»IWIN»M) 

MULTI 

0OO002 

c 

MULTI 

ooooni 

c 

THIS  SUHffOUTIME  CALCULATtS  TME  MUl  T I-TfcHPp)T AL  BRKOH  FOR  TRAINING 

multi 

OOOOOit 

c 

SFGMt-HTS. 

multi 

oooon'j. 

c 

hULTi 

000006 

c 

CAMS  CONTROL  CARD  INPUT  DATA 

CAHSCM 

(100007 

COMHON/CAMSCM/  IMODFLtIMULl I » I S I GF X t ISK IP 1 1 THAX * 1 REP ♦ IWINOt 

CAHSCH 

OOOOOfi 

1 ir.ROUPCitPf  )'i)  iMS(3,E*3)fG(3i2»a)tH(5t2»23 

CAHSCH 

000009 

rFal  ns.  • 

CAHSCH 

OOOO  1 0 

c . 

CAHScM 

OOOO)  \ 

COMHOri/T  RPOR/T ITL  <<0  t iDATFfPtSlIHtTOTt ALOCAL  tFRTOT(?) 

) RROK 

OOOOU 

1 ,).HrIAS(3)  ,LRRAND(3),CI  T0U3)  tCLHIASfi)  f CLP  AND  ( 3)  t DELTA  t 

ERROR 

noooli 

1 CI’OPO*  7(3,P)tMULT(3),l  iDflRAlNAfTRAIND 

ERROR 

0 0 0 0 1 O' 

DIHFNSlON  IFRS(/lo)  3 

error 

OOOOI!> 

ERUTVAtrNrt’n  TTl  . URS) 

error 

OOOO  1 0 

KML  NtJl  1 

I.Rr  or 

0000)7 

IMIFUFP  TrO.cRuPD 

error 

000016 

INTFCfcR  TYPffSlASON  ! 

multi 

0000)9 

OIMENSiOf)  IKINC'O  tiNDEiXfl6) 

multi 

0000?0 

REAL  N 

MUl  T-1 

0000?1 

DATA  IhNFX/0,)  ,2,b,3,6'tS*  n t^t7t9tl2t10f  iSiIOf  15/ 

multi 

oon<)?^ 

1FIMi;=i+4^IH(  1 )+2YIWJn(P)  tOtlWlNli)  +0»IWlN<a) 

multi 

nooo?,i 

ISTAH  =IMDEX(1HNn) 

MULTI 

0000?0 

Iwiu)N  = n.i-'ONPM  YPF»SLAt|nN»  ISFATE) 

MULTI 

0000?‘j 

N = Nfl(TYl'LtSFA.'^ONT  IwHATli) 

multi 

OOOOP6 

c 

ERROR  HrpORT  CALCULAnON 

MULTI 

0U00?7 

10  CONTI  rnjF 

multi 

OUOoPi) 

HULT(FYPn=H 

MULTI 

0000.29 

RFIIIRN 

MULT  1 

000030 

emi 

multi 
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000001 

SUbROUrTNF  PaGFH  (NLInES) 

PAGFR 

000002 

c.  . 

AUTQl  ATIC  PAGING' SUBnOUTINE,  PERMITS  A 

MAXIHL'M  OF  HXLINE 

PAuFR 

000003 

c 

1 INtR  PtP  PAGE.  • • 

■ ^ 

PAUFR 

000000 

c 

PAGf  t.IfcCT  CONTROL  PARAHEfERS  FOR  LEM 

PAGFR  ■ 

000005 

c 

PAGFCM 

OOOOOtJ 

COMMON  /PAGECM/ 

pagfcm 

000007 

t NPACP  tNllNp  ,HXL1NE,n‘sTTL  tSUGTTLno) 

PAorcM 

oooooo 

c . 

pagflh 

000009 

c 

PA(,FR 

OOOOiO 

c . 

P/GFR 

OOOUl  1 

Nt  1NF=  NLINF  + f^LINFS 

paofr 

0000  12 

IF  ( NlTN£  ,UF.  MXLINE  ■)  GO  TO  900 

PAGFR 

000013 

c 

PAGFH 

OOOOIO 

CALL  FjrCT.FNLINES) 
RF  FORM 

pac.fr 

oooolb 

900 

PAGFR 

0 0 0 0 ! 0 

LNO 

PAGFR 
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r 1 


OOOOOl 

function  PSUU  (XX) 

PSUB 

000002 

c 

CALCULATES  FUNCTIUN  PCX)  FOK  CONFIDENCE 

lEVEL  CALCULAIIONS 

psun 

000003 

c 

, 

PFUR 

000004 

x=  AbS{XX) 

PSIIH 

ooooos 

■'  c 

IP  AyS  (X)  .GT,  I 

,E?0t  then  set 

Pfx)  = 0 

IF  X IS 

NEGATIVE 

PSUB 

000006 

c 

OK  p(X)  = 1 IF  X 

•IS  POSITIVE. 

PSUB 

000007 

PX  = 0.0 

PSUB 

ooooort 

■ IF  ( X ,GT,  J.F20  ) 

GO  10  ROO 

('SUB 

000009 

PXa  (((  0,019^27»X 

+ 0. 000340  )KX 

+ O.UblOfl  )#X  + 

0,196e'54  )*X 

PSUB 

nuooi  0 

1 » 1 . tJ 

PSUB 

0 0 0 0 1 1 

PXs  0.5/  PX*»'4 

PSUB 

000012 

000 

IF  ( XX  .GT,  O.O  ) 

PXS  1,0  - PX 

PSUB 

00001  3 

PSUR5  pX 

PSUB 

0 0 0 0 1 4 

900 

RTTUKU 

PSUB 

oonolij 

ENU 

PSUB 
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FOK,IS  KANACF 

SUBRCUJTINe  RANACF  ( I F I L E , I RE  C » BUF  , N , I X , L r I OP  T ) 

C STANDARDIZED  RANDOM  ACCESS  I/O  ROUTINE 

C OPENS»  CLOSES,  READS,  AND  WRITES  A RANDOM  ACCESS  FILE  USING 

C INSTALLATION  DEPENDENT  RANDOM  ACCESS  ROUTINES 

C UN  THE  CDC  6600  COMPUTING  SYSTEM  AT  TRW  THE  OP ENMS , CLOSEMS , 

C KEADMS,  AND  WRITMS  ENTRY  POINTS  ARE  USED  TO  ACTUALLY  PERFORM 

C THE  RANDOM  ACCESS  I/O  OPERATIONS 


C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


INPUT  PARAMETERS  ... 
JFILE  = LOGICAL  UNIT 
IREC 


BUF 

BUF  IS 
M 
IX 


I OPT  = 


NUMBER  OF  THE  RANDOM  ACCESS  FILE, 

= RECORD  NUMBER  TO  BE  READ  OR  WRITTEN, 

= ARRAY  OF  LFMGTH  N TO  CONTAIN  THE  RECORD, 

INPUT  IF  lOPT  = 2 AND  IS  OUTPUT  IF  IQPT  = 1) 

= LFMGTH  OF  RECORD  TO  BE  READ  OR  WRITTEN, 

= ARRAY  OF  DIMENSION  L CONTAINING  THE  INDEX  RECORD, 
= LENGTH  OF  INDEX, 

ENTRY  POINT  OPTION  .. 

= 0 TO  OPEN  THE  FILE, 

= 1 TO  READ  THE  FILE, 

= 2 TO  WRITE  THE  FILE, 

= -1  TO  CLOSE  THE  FILE. 

DIMENSION  BUF(N),IX{L) 

LINKAGE  ...  CALL  RANACF  ( I F I LE , I REC , 8 U F , N , I X , L , I □ PT ) 
RANACF  IS  CALLED  FROM  INPCHK,  CAS,  WRAPUP 


SUBROUTINES  USED 


OPENMS, CLOSEMS,  REAOMS,  WRITMS 


s ,-;c  Sf:  5|i  sis  5"^  sic  sis  s;s  sis  sis  sis  sis  3}:  3|S  sis  sic  sis  sis  >;s  sis  sis  s;s  sis  sis  sjs  sis  sis  s;s  sis  sjs  Si'S  sis  sis  3|s  s|s  :1s  si:  :1s  s|;  sis  sis  sis  sis  sissis  sic  sis  sis  sis  sis  sis  sis  sic  sis  s;s  sic  sissls  sis  ^ ^ 5>i  sis  sis  sis  sjc : 


IF  { lOPT  .EO.  -1  ) GO  TO  AGO 

IF  { lOPT  “ 1 ) 100,200,300 

C lOPT  = 0.  OPEN  FILE 

100  IFUFII.E  .EO.  A)  DEFINE  'FILE  A ( 506, 303,  U,  IDUMl  ) 
•‘IFIIFILE  .EO.  1A)DEFINE  FILE  lA  ( 388  ,5  OA  , U , I DUM2 ) 
IF(IFILE  .EO.  15)DEFINE  FILE  15 ( 388 , 81 , U , I DUM3 ) 

■ IFIIFILE  .EO,  16)DEFINE  FICE  1 6 ( 50 , 1 020 , U , I DUMA ) 
IF(IF1LE  .EO,  17)0EFINF  FILE  1 7 < 3 20 , 39 , U , I DUM5 ) 


RANACF 
KANACF 
RANACF 
RANACF 
RANACF 
RANACF 
RANACF 
RANACF 
RANACF 
RANACF 
RANACF 
RANACF 
RAN ACF 
RANACF 
RANACF 
RANACF 
KANACF 

RANACF 

RANACF 

KANACF 

RANACF 

RANACF 

RANACF 

RANACF 

RANACF 

RANACF 

KANACF 

RANACF 

RANACF 

RANACF 

RANACF 

RANACF 

RANACF 

RANACF 

RANACF 
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GU  TU  yoo  ranacf 

C lUPT  = 1.  READ  RECORD  IREC  RANACF 

200  READ( IFILE' I REC t ERR=600 ) (BUF{ I ) , I=1,N) 

•GO  TO  900  RANACF 

C lURT  = 2.  WRITE  RECORD  IREC  R/^NACF 

300  WRITE!  IF  ILE' IRECt  ERR  = 600  ) i BUF  ( I ) r I=^L»N) 

GU  TO  900  ranacf 

,C  lUPT  = -1.  CLOSE  FILE  RANACF 

■ 400  CUNTINUE 
GO  TO  900 

600  WRITE ( 6,901 ) iFILEt IREC 
STOP 


901  FORMAT!  1H0,91H  AN  IRRECOVERABLE  I/O  ERROR  HAS  OCCURRED  ON  READ 

lING  A RECORD  FROM  A DIRECT  ACCESS  FILE  / 

210X,6H  FILE=,I5,8H  RECORD=,  1 5 , 3 IH  THE  JOB  IS  BEING  ABANDONED 
900  RETURN 
END 


RANACF 

RANACF 


0 FUT  RDMlAtlt760il?/t  39507  • , t 


000001 

SlMiROUTlNF  HO'nAtFLtU) 

RDHl  A 

000002 

c . 

KAHnOH  MUH8FR  GFNFHATnR  FOR  ALL  COMPUTERS  ; 

ROMU 

OOOOOi 

IHUJULF  P|<rCI6»0N  Cl  »C?fRlfR2t  TfFLt  TWOSifONt.tZFROfXMOUttHOO 

Rnm  A 

0 0 0 0 n 't 

OA  lA  n TCPffll-ir.f  7KR0/30S1  /493/fc.Ol»a4if>b.D0i  1 .O0»O.U0/t 

ROMl  A 

OOOOOS 

•t  Tw<i3S/3i<  ib9/3«.3(>H.nO/ 

ROMIA 

qoooofa 

XMOntT)  = OMOiUTtTwnic;) 

ROMl  A 

00000/ 

tMOlHT)  = UMOi)(T#2o?la9.UO) 

ROM  A 

0 0 0 0 0 0 ■ 

T = FL  , 

ROMl  A 

000009 

IF(T  .IF.  2ERO)  f = UNt 

RI'M  A 

oono ! 0 

HP.  ~ YrtOD(T) 

RI1M!  A 

ooooii 

' R1  = T - 92 

IvDIll  A 

000012 

T = XllonCXMODtC  H‘R2  + C2FR1)  + C2*R?) 

RPM  A 

000013' 

U = r/TK035 

RPH!  A 

000014 

• 

Ft.  = T 

' KPMa 

0000  1 5 

HMIIRN 

RPMl  A 

000016 

ERU 

ROM!  A 
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000001 

SUbROUTlNF  report (IPASS, IF TRSTtIREP) 

RFPORT 

000002- 

c 

RFPORT 

000003 

c 

THIS' SDbRUUTInF  PRINTS  ThE  CAhS  REPORT. 

RFPDrT 

00000/J 

. c 

RF  PORT 

OOOOOb 

c 

pace  EJtCT  CONTROL  PaRAMEIERS  FOR  LEM 

pagfcm 

000006 

COMMON  /PAGECH/ 

ra(.f:cm 

000007 

1 NPAyf  ,NLINE  tHXLlNh,)5STTL  tSURTTLdO) 

PAGFCM 

OOOOOti 

c 

> 

pai.fcn 

000009 

C0MMOM/FRRnR/TlTU4)  , lOATEf)’L51  IM»TOT»  AlUCALtFRT0T(3) 

t)'’ROR 

0000)0 

1 t)  Wol  AS(  5)  tERRANOCO  tClTOT  C3)  tCL‘UAS(3)  fCLRAN0(3)  lOELTAt 

tl>l(OR 

OOOO  1 1 

1 CRUf’D*  /(it?)  TllULr(3)  ,TIO*  IRAINAfTRAINO 

F RROR 

oooy  1 2 

OlMfN-lSlON  IFRS(«0) 

LRHDR 

0000)3 

EOUIVAiFNCLCTnitlERS) 

1 RROR 

0000  1 0 

RFAI  Hij)  T , 

l.R|!OR 

oooois 

- 

IMl'rOFH  TIlJtCROPl) 

LRIiOR 

nooo ) 6 

COMPOM/SI  r,  rRU/(;nUN4t  lREC4t  IZ0Nh4tISTKA4fISU64»lSEG4t 

SroTKO 

0000)7 

J I1,IPRT0R(6),1SHV<,PT(2) 

SrcTRU 

0000)6. 

c 

FUfc  OFHUTUONS  AND  RECORD  LENGTHS 

FIIFS 

0000)9 

COMMON  /ruts  / 

Furs 

000020 

1 ShCj))  .1  SC0)0,CR()PW  ,LCRO)'WfSUBHSr  tLSUGH  »ACOOIStLACO 

f ILFS 

000021 

2 tCAMsF  ,LCAM{,FtCAMtRH,LCAMLRfCASF  tLCASF  t YtSOUT . L YLSO 

FUFS 

O000P2 

3 f Sir.FVTtLSlCtXt  YhSERRtl  YtShRi  StCTPU.LStCTRtCASDIStLCASO 

FUFS 

000023 

4,  fINP  tOUlP  .tTACO  .LTACtJ  t CASOSF  1 l.C ASOS' 

f U.FS 

00(1024 

• 

INTFCPR  StCJI)  tCROPW  fSUMliST.ArvDlStCAMSF  tCAHlRRtCASF  tYESOOT 

F ID  S 

000026 

1 tSKJrxTfYtStRRtSroTRUtCASOlSfODlP  tlACU  tCAS)5SF 

fills 

000026 

' c 

F UPS 

000027 

dimension  inuT(3) 

Rf  I’ORT 

000026 

1 

CONTlNijF 

RFI’OKT 

00002V 

IF (TRASS. FU.?)  CO  10  200 

RD'ORT 

0U0030 

IF (TPasS.FQ.O)  go  10  300 

RFHORT 

000031 

RF  port 

000032 

c 

RFPDrT 

000033 

, 

C TKAlMTflG  Sbf.MrNtS 

RF  1‘ORT 

000054 

IFUMK'Sl.GT.l)  GO  TO  lO 

R( PORT 

00003S  ■ 

c 

RFPORT 

000036 

C FIRST  AC(})1IS.  FOR  SECMtNl  - PRINT  flEAOERS 

RFPORT 

000037 

CALI,  PaOLR(7) 

RF  port 

000.036 

WRITL(l)OIP»  1 3001 

Kl  f'ORT 

00003V 

WR1T!.(o!)IPt  1000) 

RFPORT 

OOOO'IO 

looo 

F ORmaI  ( 1 Xt  1 1 ( 10H» ) 

ItFpnRT 

OOOO'll 

WRlThfrjUTPt  1 100)COUN4,lr?EG4tUONt4,ISTRA4.ISU64f  IStG4 

RF  PORT 

00004? 

IlOO 

F0l<NAT(2X,ttliC0UNI»Y  t A4 , 6H , HE G 1 ON , ,12t6H,Z0Nt  tI3» 

KFPORT 

000043 

1 6(1, STRATA  ,Ii,tlHtSU65TRAlA  * 1 4 » 1 6H t TR AIMING  SFGHENT  »I4) 

RF  PORT 

000044 

v.PlTtri,OTrti200)(’Tct)  I 

KFPORT 

00O04S 

)200 

FnKHAT(2X,?2)iTRUt  RRUPOPriON  Wnl  AT-i  tF6.2)  ' 

RF  PORT 

000046 

WRITtdjUrPt  1300) 

HFPDhT 

00004  7 

1300 

FORItAT(2x) 

RTPOKT 

000046 

IF(TRFp.tF.O)  GO  TO  20  ■ 

RF  PORT 

O0O04V 

WRULfdOIPt  1400)  ■ 

Rt  PORT 

O0O04O 

1400 

FORMAT  (?X  , 1 7XtV1lAC()  DATF  t7HtSTIH,  tVMTOTAL  tl?Xt 

Rf  PORT 

oonoM 

1 7H) rROR  , lOX, )3HCl ASSIF.tRHORfbXtSHCROR  tOXtGHMULTI-  ) 

Rl PORT 

00006? 

WRlTLIoOn't  1‘jOO) 

Rf  PORT 

000063 

1600 

FORMAT (2X,  17HCHOH  WINDOW  ’ fVHMO/OY/YN  »7HPR0P.  t 

RF  PORT 

000064 

1 7HfKR0R  ,SXt2(7MKMEAT  t/HMlXfO  ,7IIOTHrR  ) t'jNCAL  f4Xt 

HFI’DrT 

000066 

1 4ln^l-,P) 

RF  port 

000066 

r.o  TO  iO  •' 

f'.FPORT 

00  no  6 '7 

20 

C07lTlnuF 

RFPORT 

000066 

Moni  (oDiPfUOo) 

Rt  I'ilRT 
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OOOOS9 

■ 1600 

FflkMAT(2X»  17Xt9HACU  DATF  tTHtSTlM.  f2Xf7HTUTAl  ) 

REPORT 

000060  ' 

HlUTL(otHP»1700) 

KFPORT 

OOOOM 

1700 

F0RHATf2Xt I7I1CROP  WINDOW  ♦9HM0/UY/YR  flHPROP.  f2Xf7HfcRRnR 

)RFP0RT 

0000*2 

■ 30 

CONTHlur 

RF  PORT 

OOOUOi 

10 

cnNTlWUF 

HFPflRI 

0000*0 

IFUKpp.LT  ,0)  GO  10  <40 

RF'PORT 

000065 

tALL  PA0tW(3)  • 

R!  PORT 

000066 

CALL  FZULUCTDATCr  lUUn  1 

HFPORT 

00006  / 

WRIT!:  rnllTP»  10lOMTlTLCn»I=lt<i)fICiLlTC?)  » I OUT  ( 3)  , ICUT  ( U »Pt  ST  1 « t 

KF  port 

000060 

1 TOT*  ftr<in{(nfI  = l,3)*CCLTOT(ntI  = l*5WDLlTAtHULim 

Rt  f’ORT 

00006V 

1010 

FnhMAT(2Xt<tAT*lX»T2«2(lH/'tlH)f  1X*F6,2,1X*F7.2  tSHTOI  t 

report 

000070 

1 6(f 6. 1, IX) tl S,2f 2Xt2nw  *F4.2) 

RFPCIrT 

000071 

WRntfol'IR,  I0?0)  ( (.RUT  ASU)  *1*1*3)  * (CLblASm*  1*1*3)  tCROPD* 

HI  PORT 

000072 

1 m<LT(2) 

RFPORT 

00007i 

1020 

FORMAT  («2.Xf5ni)I  AS  *61f6.4,  IX)  * 13  *4X  *2HM  *Fa,2) 

RFPOrT 

00OU70 

WRlTt(olJTP*)030)  (tRRAUnd)  *1  = 1*3)  t (CLR  ANO  ( T ) * 1=  1 * 3)  * 'IULT  ( i) 

REPORT 

000075 

io30 

FnHM'AT(«2X(‘5nRANU  * 6 C F 6 , 3 * 1 X ) * VX  * PHO  *F<1,2) 

RF  port 

0 0 0 (1 7 6 

Rf  FORM 

Rl  PORT 

000077 

<10 

CONTI MUl 

RFPORT 

000070 

CALI  f zl'Uint)ATe*IOlJT) 

report 

0 0 0 0 / V 

CALI.  PaFU  R(1) 

RF  port 

oooooo 

KRlTLT'oUIP,  10“0)  aiTUn)»I  = l *<))  *iaUT(2)  #10UT(3)  *IOUT(  1)  *PF8TIP»T0Tf<rP0HT 

000  00  1 

1000 

FOI(MAT(2X*4A4*lXtI2*l»/'*12*  1M/*I2*  1 X * Fo. 2 * 1 X .F  7 .2) 

RFPORT 

0 00  0 02 

RF  lUKN  - . 

RFPOrF 

OOOOfii 

RCF’ORT 

OOOOf'O 

c ■ 

report 

000005 

C ORDINARY  SEGMFNTs  • . . 

RF  PORT 

0000P6 

200 

CONTINLiF 

RF  PORT 

OOOOO7 

1F(1Hr3T.GT,1)  30  TO  230 

F<f  PORT' 

OOOOfiO 

c 

RFPORT 

OOOOJ’V 

C FIRST  Ar«.  FOR  31  RHCNT  - PRINT  HL'AOFRS 

RFPORT 

OOOOVO 

CALI  PaOLRCT) 

Ilf  port 

oooovi 

WRITt(ol!1P*150t!)  ■ .. 

RF  PORT 

000002 

WRITl  (oUTP* 1 oOO) 

KFF'ORT 

0 0 00  V J 1 

WRm  CofJlf’*PlOO)COON4,lRb.G<t*IZUNL'J*  ISTRA4*ISUH<1*IStC4 

H!  PORT 

0000 vv 

2100 

format  (?X,3HC00NTI’Y  , A<4*RH^RFG1UN  *I2*6H*70NL  *13* 

RFPORT 

OOOOV5 

1 «H*STRATA  tlltllHtSUBbTRATA  * 1 <1  * 1 6H * ORO 1 NARY  SLGMfNT  *14) 

RFPORT 

0000V6 

WRlTK(nUIP,l20<nPTCl) 

HF  PORT 

000097 

HRI7Lf(lUTP*li00) 

REPORT 

000090 

210 

CONTI Nij!  ' ■ 

report 

OOOOOV 

IFUKr  P.LF  .0)  on  TO  2?0 

hf  PORT 

000100 

WR)  rc  C(|lJTR*2<lOU) 

RF  port 

0001 0 1 

2400 

FORHaT(2X,17x*VF>ACiJ  OATF  *7HtSTlM,  */HTOTAL  *1?X* 

RFF'ORT 

000102 

1 TUFrROR  *10<*1UHSTG,EXT.  *22X*5HTRAIN) 

report 

000105 

wRiri  {(iinp,?bOo) 

report 

000106 

2500 

FOKIiAT(?X,17|!CR')l*  WINDOW  t9HF!0/DY/YR  *7HPH0P,  * 

RrpORT 

O0O105 

1 THIrROR  tSX*2(/HWHF.AT  *7HMIXFD  *7MUTHFR  )*2X*6HZ1  * 

FvEPOrT 

000106 

1 6HZ2  *<4HStO.)- 

report 

00010/ 

GO  TO  230 

RF  P0^4T 

000106 

220 

CONT  U-ijF 

Rl  PORT 

oooiov 

HRin  t()ijip*i60o)  ■ 

RF  port 

000  1 1 0 

WRITt  foinp*l  700) 

RF  PORT 

0001  1 1 

230 

CO(4T1NuF 

report 

0 0 0112 

C 

' * * . 

RF  PORT 

000  1 1 i 

C PRINT  lfif-0 

Kl port 

0 <10  11  '1 

If  ( FRI  P.LF  .0)  (,l)  Tu  2<l0  V 

Rl  F'ORl 

0 0 0 1 1'j 

LALI.  Pa(-LRC3) 

report 

000116 

CALL  1 /tlUKTOATEflOUT) 

REPORT 

00011/ 

HR  III  ((ilifP*?0l0)  (T  lTLm*T  = l f«)*IOUT(?)  , LOUT  (3)  . 10UT(  1 ) ,rF8Tl«* 

RF  PORT 

0001  1 a 

1 tOI.  {tRTOffn*)  = !*3),LCLTUT(n*I  = 1.5)r(^fS*l)*Is1*2),lID 

RE  PORT 
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oonii9 
oooi?o 
000121 
000122 
000123 
.000  120 
00012b 
000126 
000127 
000  120 
000129 

000  no 
000131 
00O132 
00013'i 

000 1 30 

noo 1 3b 
000  no 
000137 
000130 
000139 
000100 
0 0 01/11 
0 0 0 1 '/  2 
000103 
0 0 0 1 /J  0 
ooolob 
OOni'JO 
00!)]/)/ 
OOOIOU 
000109 

n 0 0 1 ')  0 

00  0 nil 
000192 
000  1 '■■.3 


2010  FO«MAT(2XtOA/(tlXtIl't2(lH/»12)*lXtF6.2tlXtF7.2.  • »5H  lOT  f KF.2nt<T 

1 6{F6.3»1XJ  f2HH  i?(rb.2WX)*IO)  Rr-POHT  . 

■ WR1TE(oUTPt2020)  ( £R13  I AS  ( I)  » I=  U 3)  » (CLb  I AS  ( I ) 1 1 = 1 1 3 ) » KFPORT 

. 1 (7(?,I),I=1»2)»T!AImA  . KrpOKT 

2020  F0K“A1  ('I2X,Sm9IAS  ,6(f.  o.  3 * I X)  t2HM  , 2 (F  b,2 1 1 X ) f F 6,?>  HI  PORT 

HimLto»IPt2030)ALUCA|  t ( F.RR  AND  m f ! = 1 , 3)  r ( CLP  ANti  f I)  , 1=  1 1 3 ) » HFP.'IK’T 

1 (7(3,I)*I=lf2)fTRAlMD  KFPnHT 

2030  F0PMAT(3*>X,F6,2»lXtbHRANU  * 6 (F6 . 3 * 1 X ) ♦ 2H0  1 2 ( Fb  . 2 1 1 X)  t F 6 . 2)  ’ KFPORT 

KFTDPM  ■ . PFpnpT 

2/10  CONTINuC  ‘ KEPOhT 

CALI  PaCLRU)  KFPOWT 

CALL  F ^IILIK  IDA  rP  . TOUT)  RFpnRT 

hPlTt.  foUTPjlOOOUTITLCn  rial  tfl)  *inU7(2)  *10^1(3)  tinUTintPFSTlHfTUThrpORT 

RFIUKM  ■ HE  PORT 

RKPORT 

C , ' KCPOE^T 

C SPfcClAL,CASf  ■-  NO  ACUUIS.  FILE  KFPdRT 

300  COf.TIHur  KfpnRT 

IF (IFlRST.GT.t)  GO  TO  310  • REPORT 

CALI  e'ae:lp(7)  report 

WRITr(OUTPtl300)  rtport 

WP]Tt(0UlP, 1000)  KFPnRT 

RRITI  ((itirP,3100)COUN4,lREGilrIZONtOfISTRA4tlSUE)A,lSEG/*  RE  PE>RT 

'3100  KOKHAT  (2X,»licOUf)  IRY  » A4  * OH  , RE-.G  1 ON  »I2*feH,ZUNt  tI3»  REPORT 

1 Oti, strata  . Ilf  I lH,r.UPSTRATA  1 1 4 » 9H , SF  GHENT  *14)  KFPOrT 

RRlTt (oIMPf 1200)PT{ 1)  RCpORT 

Rt<lTL(UlTPt  1300)  ..  RFi’OrT 

I'iRiTLfoinPfiono)  report 

WRITL Eu"IP> I /OO)  KfPORI 

310  COHTU/UF  ■ ' REPORT 

call  pagelrci)  > report 

CALI  F/IILU(lDAtfcfIOUT)  REPORT 


WRlTLfollIP,  l040)(TlTL{l)»r=l»4)»10UTC2)  t inOT{3)»IOLlT<n,PFSnMTTOTl<f  PORT 

RE'PORT 
REPORT 


RFIURH 

LND 
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<t  FLT  RKCASrfl»760fl27»  3^093 


000001 

000002 

OOOOOi 

00000« 

ooooos 

OOOOOb 

000007 

oooooo 

000009 
0 0 0 010 
OOOOl  I 
000012 
OOOOli 
0 0 0010 

0000  Tj 
0000  16 
000017 

00001  0 
0 0 0 0 19 
000020 
0000?! 
000022 
0 0 0 0 2 i 
000020 
00  OOPS 
00  0 026 
0 0 0 02  7 
000026 
000029 
OOOOSO 
000051 
000052 
000053 
000034 
000055 
000036 
000037 
000056 
000059 

0 0 n 0 '1 0 

00000  I 
000002 
0 0 0 0 0 3 
no  00 0 0 
000005 
000006 
000007 
000006 
000009 
OOO0''0 
OOOC'il 
(i  0 0 052 
000053 
000054 

oono'i'j 

000056 
00005/ 
00  !K)'-,6 


t 1 


c 

c 


c 

c 

c 


c 

c 


1 

1 


1 

2 

5 


1 

2 

3 

0 

5 


1 

2 

3 

0 

1 


1 


SUBROUTiMr  2WCASF ' (TRFC,OSLOC»1ROWR) 

RKAdS  a I'ATA  set  from  the  CAS  CUMULATIVE  FILF  OR 
WRTTFS  a data  set  onto  the  CAS  CUMULATTVr  FILE. 

CALUMf.  SFOUEMCE  PARAMETERS  ... 

IKEC  = 1 ECORU  NUMHEr’  T,0  RFAD/WRITF 

DSI  oc.  = ('iMolh  OF  data  SET  TO  READ/hRITE 

TROViR  = PFAD/wRITE  FLAG  ( = 1 TO  KFAPt  =2  TO  RRITUl 

WHEN  RFAOING  CASFt  TME  DATA  IS  FIRST  RFAO  INTO  A OIJFFER, 

" them  the  DATA  FUR  IMF  PROPER  PREDKHOM  POINT  IS  MOVFD  INTO 
THF  origin  SPECIFIfD  IJV  ObLOC, 

WHEN  WRI.TIMG  CASF,  THE  DATA  IS  EIRST  MOVFD  INTO  THE  BUFFER, 
AND  THEN'  IS  WHITTEN  ONTO  THE  CAS  CUHULATTVF  flit. 


dimension  r)SE0C(26T 

DATA  61  OCK  EOH  CAS  ClJHIUAIIVE  FIEE 
CAS  .DATA  SETS  14.  l5,  16.  AND  17 

COMMON  ■ /CASCUH/ 

CASc.UM(.i?)  . f?UFFR(504) 

DTHENSiOU  TC'1SC{52).  DstT14{22),  DSET15(22)»  DSET16(22) 
tDSEtI /(2fi) 

eouivalence  ( ICASC.CASCUM  ) 

EOUTVAiENrE:  ( nsCT14,UsE.T15.DSET16.DSET17.CASCUH(5)  ) 

t ( sDAEKS,SualR7  »Sf)AERR.SNAERC.CASCUM(?4)  ) 
t ( sDPI  RS,SoPEH2.Sr}PFRR,S0F'hRC.CASCUM(25)  ) 

T ( S0YFRS,SuYER7»SnYFRRrS0YERL.CASCUP.(26)  ) 


flags  A-ID  COUNTERS  FoR  CAS  SIMULATOR 
COMMON  7C-(SM  G/ 

H • .PPELi;  .NOR  ,inw  fWlNOOri.lPO  »TPP  »PPUATF*NREG3 
.MiEToT  .NSTRaT.NYLSSK,NSSHSK,NcAMSK.NRYFS  iNRSSH  .nrcams 
♦ FNDc  .ftlI)REr.,ENl32nN,  IR&TH  , TR7UNE  , IRRFG 

ftOSl  .IDS6  fL0S7  ,L0S6  .LDS9  .LDSlO  .1DS11  .L0S12  ,IDS15 
»IDS14  .L0SI5  .LDS16  ,LI)S17  , t HCb'UN  . LRHF  G .LR70NL  .LHSTK 
INTFGER  PRFLC  . WIHDOW  t PPDAIE 


FitE  DEnNinoNS  ANO  RECORD  LENGTHS 
COMMON  /Fllt.S  / 

SLrjD  ,t  .SE.GlDtCKOPW  , LCROPW  . SUITHS  T . LSU6H  .ACOUIS.LACO 
.CAMsF  »l  CaMSF.CAMLRR.LCAMLR.CASE  .lcasf  .ylsuui .lyeso 
.SIGeXT .1 SiGFX.YtSLRR . LYFSLR.se GTRU.L5LGTR .CASOTS.LCASO 
tINP  .0U7P  »TACU  .LTACO  .CASOSE .LCASUS 
INTFGFR  SEGID  .CROPW  . SUOllS 1 , AC OU 1 S , C AMSF  .CAHERR.CASE  .YFSOUT 
.STGFXl  »YLStRH.5F(iTRII*CASDlS.0UTP  tTACU  .CA60SF 


INDEX  RECORD  FOR  CaS  CUMULATIVE,  FUE  (CASE) 
COMMON  /TXCaSE/ 

TXrASE(  1)  .liXCAS 


SET  pointer  TO  PICK  UP  PROPER  DATA  SET  FROM  BUl'FFR 
L=  (IPp  - 1>*26  +1  , ' 

IRHs  IrDWU 

IF  ( I«W  .EO.  1 ) GO  TO  300 
move,  DATA  set  into  UtlErLH. 


RKCASF 
RWCASF 
RWCASF 
RV'CASF 
KWCASE 
RWCASF 
RWCASF 
RWCASF 
RWCASF 
KWCASF 
KV  CASE’ 
RE  CAi>F 
RWCASF 
RWCASF 
RWCASF 
RWL  ASF 
rllasf 
CAsruM 
CASCUM 
CAbCtiH 
CASr.UM 
CASCRH 
casclim 
CAsruM 
CASCuH 
LAsCllM 
LASCUH 
CASCUM 
CASCUH 
LASELO 
CAsrcG 

casflg 
LAbELG 
C ASE'lG 

ca&flg 

CASFLG 

CASE'LG 

CAsFlG 

MU'S 

E ILFS 

E ILFS 

E ILFS 

E ILFS  ■ 

ETLFS 

F ILFS 

E ILFS 

FILES 

IXCASF 

IXLASF 

IXCASE 

IXCASF 

HWCASE 

kl.'CASF 

RWCASF 

RWCASF 

KWCASF 

RWCASC 

HWCASE 
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^ 0000S9 

DO  210  1=1 t2» 

RWCASF 

000060 

81)FFK(l)=  DSlOCd) 

hwcasf 

000061 

210- 

L=  L 1 

RRCASF 

-000062 

c , 

KRCASF 

0 0 0 0 6 i 

c 

WOK  PFAO  OR  WfmF  data  from  or  onto  random  accfss  file. 

Rl-  CASF 

■000060 

300 

CALL  RaMaFF  <CAS1 rIREC»8UFFRtLCASFilXCASFtLTXCAS»lRH) 

Kt'-CASF 

00006b 

' C 

KWCAfcF 

000066 

IF  { IrM  .to.  2 ) GO  in  900 

rkcas’f 

000067 

c 

RKCASr 

000066 

c 

data  was  read  from  file,  nor  move  data  from  buffer  into 

RRCASF 

000069 

c 

PROpFit  data  set. 

rvjcasf 

000070 

DO  310  I=lj2H 

RK'SF 

000071 

bSLOCfll*  BUFFRCL) 

KV'tA’SE 

000072 

310 

L='L  * 1 

krlasf 

00007i 

c . 

rkcasf 

000070 

900 

RETURN 

RV-CASF 

oono7i> 

• END  . 

RRC ASF 
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(.  ELT  RWni3Ftl*760'427T  i90*>S 


000001 

OOOOOiJ 

oooooi 

OOOOOO 
00000b 
000006 
000007 
000006 
000009 
OOOOt  0 
OOOOt  1 
0000  1 i. 
000013 
000010 
00001b 
000016 
000017 
000018 
000019 
OOOuSO 
ouno?i 
oooo?2 

0000?3 

oooo;’« 

0000?S 
O000?6 
OOOOf.'/ 
OOOOl’d 
0 0 0l)?9 

oooo'io 

000031 

00003;^ 

000035 

000030 

00H03b 

000056 

000037 

000030 

000039 

OUflOOO 

oooo'il 

oooooi 

000005 

00  0 00  a 
00000b 
000006 
000007 
nooooe 

000009 

OOOO'iO 

nooosi 
ocooii; 
OOOOS5 
OOOObO 
OOODSb 
0 0 0 0 ■'  6 
0000  S'7 
(lOOObl! 


f 1 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 


c 

c 


"c 

c 


c 

c 


1 

? 

3 


1 

1 


7. 

5 


1 


1 

2 

3 

0 

s 


1 

? 

3 

0 

1 


SUOROUIINF  RWniSK  ( ILFVFLtOSET) 

REA()S  AND  WKITFS  UaTa  FROH/ONTO  THF  CAS  DISTRIBUTION  fILF* 

CALLIVc  SFOUENte  PARAMETERS  ... 

LEV|  I = 0- FOR  country 
= 1 FOR  HbOlOrJ 
s ? FOR  ZONE 

DSFT  = data  SFT  13  FOR  COUNTRY 
= data  SFT  1?  FOR  REOION 
= Data  sft  it  for  zone 

dimension  DsETUR) 

COMMON  HLOCVs 

CAS  rOMTRul  CARO  INPUT  DATA  AND  CONSTANTS 
COHMUM  /CASCM  / 

AlUAFFtYCF  .PRDCF  , APriUT  S ( 0 , ? ) iPPRUTS(S,?)  .yPRuTSOf?! 
t AKl aPSiSFMAX  iNHISTY.HH  tTOPT  . AUN IT S t D 1 STF F . UW IND C 0 ) 
tUl’PiDRCO)  tAPREp  ,lPHn(5tlO)  * NPi)A  I F » PHDATE  (1 0 ) 

INTFOFR  HHf  TOPlf  AUNlT6tDISTFF,0wlND.WPR10RfAPRrPTpRl)ATt 

data  ULOCK  for  CAS  CUMULAHVE  FILE 

CAS  DATA  SF13  lOt  tbj  16»  AND  17 
COMMON  /FASCUM/ 

CASctR-K  5?)  f HUFFR(SOO) 

DlFirN'llON  tCASCn^l)*  IJ3LT10(?2),  DSF, 715(221  f 0SETI6(22) 

.nSETl 7(2«) 

fcOUIV7t,rNCE  ( TCASCtCAsCUM  ) 

LOUIVnfNCE  ( DSF  I 10,I)SLT15,()SFT  16tl).3ETl7,CASCUM(b)  ) 
f C sDArKS,Si)AERZtSnAriiRrSllAFRC.CASCUM(20)  ) 
t C sopf  RS, SOPER/, SnPrKRtSiJPERC*CAsrUM(?bI  ) 

, ( SOYI  R3,SuYE«Z,3orrRR«Si.JYtHC»CAbrUM(2o5  ) 

data  III  OCn  for  CAS  OlSTRlUUnON  FILE  (DATA  SFT  19J 
DIHF.ISIDN  CASt).Stl(50  5l 
EOUTVAlFNCE  ( CASOSH.OIJFFR  ) 

DTMFNSiON  KA5D(505),  HWA?K(60),  HAKNFY(60),  P1K(60> 

EOUIVAlfurF.  ( JCAS0,HWa2K,CASDS0  ),  ( WAKNrY,CASDSII(61)  ) • 

, I pTK,CA$()H!Ul  21  ) ) . 

flags  and  COUNIERS  FnR  CAS  SIMULATOR 
COmiON  /CASFLG/ 

M ,PPFIG  ,NOW  ,IMH  ,NIN0C)W,1PD  rIPP  .PPOATE  f NKEOS 

♦ NZToT  tNSTRaT.NYI  SSK,NSSHSK,NCAHSK,NRYF  5 jK'RSSH  .NRCAHS 
,I:NDC  ,I.NDRLr,,ENDZr)N,lHSTH  , IR70NE  ,IRRF  0 

fUlSl  ,LDb'l  ,L0S7  ,L0S8  ,!  OSV  ,LDS10  ,1.0S11  »LDS12  ,LI)S13 

tlDSl'l  ,LD3lb  ,ll)S16  ,LDSI7  tl.KroUN  .LRRF  G ,l  R70NL,URSTR 

INTI  (, Ft;  PPFLG  , RIMDDW  , PPDAIF 


HIE  UFFunnuNb  and  KrcoRi)  iengths 

COMMON  /FILLS  / 

SlGlI)  ,L,r>bGlD,CROPw  ,LCROpR,SUIUtST  .LSUllH  ,AC0UI5.LAC0 
tCAMbI  tLCAHGF  tCAMERK,LCAMfRrCA5F  ,LCA5F  , YEsSOtlT  ,LYh  SO 
»SI(.(  X)  ,LS!OtX,YLSERK,L  Y(.nLRi5LDIRU,LS!  0 li;,rASOTS,LCASD 
,inp  fUUiP  tTafo  ,ltaco  ,r,\sust‘ ,lcagos 
IMTrr.lH  Si  (111)  ,(RI)PW  tSUDiiS  ( f AruHlS  {CA'ISF  ,CAMFUR,rASF  ,YESnUT 
fSrCf  xTiYLSERR,bM.TRU,rASl)I3,UUlP  iTAfU  ,LAbDSF 


rkdtsf 

RWDTSF 

HWOtSF 

rwdtsf 

RNDISF 

RNDISF 

rkotsf 

KWDI3F 

RWOI.SF 

KNOTSF 

KPOTSF 

RMDISF 

RF-OISF 

RN01SF 

Rlvu  tSF 

LAbCM 

CAbCM 

CASCH 

CASCM 

C7SFM 

tAbCH 

CAbCM 

CAbCUM 

CAbCUH 

CAsrijM 

CAbCUH 

CAbCUM 

CASCUM 

CASCUM 

CAbCUM 

CASCUM 

CASCUM 

CASCUM 

t ASCljM 

CAbObii 

CAsnsH 

CASnsB 

lAbDSO 

CASDSO 

CASDSO 

CASDSO 

CAbKLO 

CAsri  r. 

CAbFLR 

CAbFLC- 

EAbl  LG 

CASFLG 

casflg 

CASFLG 
CAbFLG 
I 111  S 
F ILFS 
I TIES 
F ILFS 
files 

MLFb 
F ILF'S 
F ILFS 


28234-6029-RU-00 
Page  499 


0000S9 

C . ' ■ 

i 

F TLFS 

OOOOhO 

c 

i DA7a  block  FOH  CAS  DtSTKiBUTION  Fill-' 

IXOISF 

000061 

COMMON  /IXDISF/ 

IXOISF 

000062 

1 rXoiSFL  Df  LIXDIS 

IXOISF 

OOOOf.i  , 

c 

■ N0TF..1  *'06  ONLY  A|  LO>>S  UP  TO  a PMFOICTION  POINTS  INCLOOrNC  • 

IXOISF 

00006« 

c 

lUOrllNOOHS  ( b06  = 1 + 1 + 8*63t  INOFX  +'  HFADtR  ♦ 8 PKCO.  PTS. 

moisF 

00006S 

■■  ■■  c 

IXOISF 

000066 

c 

statistical  rNFOPHATlON  FOR  LtM  ' 

stats 

000067 

COMMON  /STaTS  / 

stats 

00006(3 

1 TTFK  ,NSEr.TR|NCAMSH,NYt.SR  tNREC(73  *NCASCHiNCASDR 

STATS 

000069 

tOUIVALFNCU  ( NlflTtl?  ) 

STATS 

000070 

stats 

000071 

. c 

RF'DISF 

000072 

c 

NOTE  ...  THCNE  ARE  9 COUNTRY  VAt OFS  PER  ITtPATlON  PFR  PREDICTION 

HWOISF 

00007J 

c 

POINT  RbOUIRTNO  3 COUNTRY  RECORDS  PtR  PRFUICTlON  POINT, 

KWDISF 

000070 

c 

ni'O  ITKUTIONS/RECORD) 

RPOtSF 

0000 7b 

' c 

' . ThifKf  a'rF  3 REC.ION  OR  70NE  VALUES  PER  ITFRATION  PER 

RUUISF 

000076 

c 

PRElJlLTlOf,  POINT  RfOUIRlNO  1 RF&ION  OR  ZOMF  RtCURO  PER 

RF.UlSF 

000077 

c 

PRlMllLTION  POINI. 

RWOISF 

000076 

c 

(100  1 ILRATJONS/RECURO) 

RF'DISF 

000079 

c 

• 

PF.OTSF 

000060 

c 

3 COUurHY  RECORDS  t 10  REGION  RECORDS  F bO  ZONE  RECORDS  o 

RwO.IsF’ 

OOOOO 1 

.c 

63  RtCUHOS  PER  PRfOIlTION  POINJ. 

R^OTSF 

000062 

c 

j,. 

rwutsf 

oooooi 

c 

RI'OISF’ 

OOOOHO 

LEVELS  TLEVFL 

RRotSF 

O0OO«b 

c 

RWOISF 

OOOOf'6 

c 

FOP  the  IPP-TH  prediction  POINT  THF  3 COUNTRY  RtCORUS  ARE  ... 

RWOISF 

0 0 00  6, 7 

c 

2 + N,  3 + N»  (l  + N RHERF  N = (IPP-DF63 

RWOlSF 

oooonu 

IREC=  2 + (IPP-1)*63 

RWOISF 

000009 

• c 

RWOISF 

OOOU'IO 

. c 

THF  10  RfOlON  RECORDS  ARE  5+Nf  6+Nt  ...t  1«+N 

RWOISF 

000091 

IF  ( 1 fVEL  .£0.  1 ) IRFC=  IRFC  + IRkFG 

RW'Ol  SF 

000092 

c 

RWOISF 

000093 

7H1  SO  ZDl.F  RECORDS  ARE  Ib  + Nt  16FN,  t 69  + N 

RV OTSF 

0 0 0 0 ')  9 

IF  < IeVEL  ,|0,  2 ) IRrC=  IRFC  + IRZONE 

RV'OtsF 

00009b 

c 

• 

RWOISF 

000096 

IF  ( NT  ,GT,  1 ) GD  TO  120  t , - 

RWOISF 

000097 

c 

FIRST  ITFKAHON,  cLFAR  BUFFFR  ANd  S-TORE  REFFRF'MCE  VALUES 

RW'oISF 

000098 

DO  no  Tsl,L(ASD 

RWOISF 

000099 

CASDSIi(I)=  0.0 

KF'DISF 

000100 

. 110 

COHTINllt  . . ■ 

ri-disf 

0 0 0 1 0 1 

c 

KWOFSF 

0001 n2 

c 

AKFa  reference  value  = TRUF  NA 

rhdisf 

000103 

CASD6r(U=  D:)FT(2) 

RFilJiSF 

000109 

c 

■ PRODUCT  10),  REFERENCE  VALUE  a TRUE  PRODUCTION 

RKOIST 

00010b 

CASDS8(?)=  D!.CT(6)  ' ' 

rkoisf 

000 1 06 

......  ..  c. 

YUlD  REFlRtNCE  VAl.Uf  = lOO.O  ‘ , 

RWOISF 

000107 

CASD61l(3)r  lOO.O 

KW'onjF 

000108 

GO  TO  l3o  . . ■ 

rkoisf 

000109 

c 

■ 

RWOISF 

0001)0 

120 

IF  ( I:t  .1  t.  ion  ) Gn  TO  I2b 

RWOISF 

000111 

CALI  FRRhfS  (3UCAS.6HRVtnISFrl7»l) 

RWOISF 

0001)2 

OlStFla  0 

RWOISF 

OOOlli 

GO  TO  900 

RWOISF 

000110 

c 

*■ 

RWOISF 

0001  lb 

c 

RFA(J  DATA  RECOrn)  Itjin  iiufffr 

RWo  I SF 

OOO  11  (J 

J2b 

CALL  I.‘aNACF  (CASDlS,lRt.C*CASl;SUTLrASOTlXUISFTl  IXDlStU 

RwbisF 

000  1 1 1 

c 

* 

RwolsF 

000118 

. c , 

SIOrF  area  LRRORi  production  error,'  and  VICLO  error  for 

RWOISF 
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0001  IV 

c 

muAnoN  Hr 

RHOISF 

0OOl?0  ■ 

liO 

CASr)SH{HI  + J)=  DSET(4) 

RWDISF 

OOOIPI 

CASI)St'CHT+103)=  DStT(fl) 

RV'-RIsF 

non 

‘ 

CASDSH{HT+203)=  0StT(l2) 

RWDIsF 

0001^3 

c 

RKOISF 

0oni^>4 

c 

KKITE -RfCU^'D  UACK  ONTO  CAS  DTSTRIBUTION  FILfc. 

I<KDISF 

nooi?b 

-■ 

CALI  RAHACh  ( C ASDI S * 1 RtC t CASOSB »LC ASO i IXU ISF » 1 1X0  IS 1 2 ) 

RWDISF 

0001P6 

c 

( 

RWDISF 

000t?7 

IF  ( Itvtl.  .HR,  0 )■  r,U  TO  900 

RHOlSF 

000 1 ?« 

c 

RWDISF 

ouni?9 

c 

PkOcEBS  SRCOHD  tOlJMTRY  RECORD 

RWDISF 

000130 

lRE.es  iRtr  + 1 

ki-dtsf 

000  ni 

IF  f NT  .or.  1 ) GO  TO  220 

RWiilSF 

000132 

’ . C 

SIOrF  RERERtHCF  VA| UpS  FOR, SECOND  COUNTRY  RtfORO, 

RVDtSF 

000133 

CASDSi3(11=  lOO.O 

KFDIsr 

000 1 34 

CASOSi3(2)=  ,to0,0 

RworsE 

00()13i> 

GO  rri  g30  ' • ■ 

rwdtsf 

000)  3(5 

c 

RWDISF 

000)37 

c 

RtA()  RFCORD  INTO  (H)FFER 

rfuisf 

000130 

220 

CALL  KANACF  (CASDISilRErtCASOSBtLCASOtlXDISFfHXDIStl) 

KWOIsF 

OUOt;i9 

C 

.RWDISF 

0 0 0 1 0 0 

c 

.SIOrK  rUrwAt  CLEt’KOt  and  clatec  for  iieratiom  ni. 

RWDIsF 

0 0 0 1 «1 

• ?30 

CASnSi!(tJr  + 3)=  i)SLT(?0) 

RWIHSF 

000142 

CASbb»(NT+ 103)3  0SET(2l) 

RWDISF 

000145 

CASDSi3(Hlt203)4  t)SLT(?2) 

RW'DISF' 

000144 

c.  • 

RWDISF 

O0O14S 

C 

write  record  back  ONTO  CAS  DtSTRIUUTU'N  FILE., 

RWDISF 

000140 

CALL  RaNAH-  (CASDIS»IPLr»CASt)SOfLCASD.  JXOISFtL  lX0TSt2) 

kwdtsf 

0 0 0 1 /1 7 

C 

RV  IjTSF 

000140 

- 'c 

rrolEss  Third  country  record 

RWOJSF 

000  1.49 

IREC=  )REC  4 1 

RWDISF 

OOOl^'O 

IF  ( NT  .FO.  1 ) GD  TO  330 

RWDISF 

000131 

c 

REFfRENCF  VALUES  AtRFADY  STORED  IN  CA5DSB. 

. RWJDISF 

0001'^2 

• • c 

RWD ! SF 

OOOl S3 

^ c 

read  data  record  into  oueffr 

R W D 1 S F 

000134 

CALI  RaUACF  (CASOlS.IRtr»CASOSy»LCASD.rXDlSF,LlXDIStf) 

RWDISF 

OOOIS') 

c 

hwdtsf 

OOOl'lO 

c 

SlORE  CLPTEC*  CLAIWC,  and  CLPTWC  for  iteration  NT, 

, RWDISF 

000137 

.330 

CASDSP(K'I  + 3)  = t).SlT(?3) 

rwot.sf 

000  1313 

CASDS(1(MT+103)=  0SET(?4) 

RWDISF 

000139 

CASnSI3(fi1  + 203)=  DSET(?b)  Ri-DISF 

OOO 140 

c' 

, 

RWDISF 

000141 

c ■' 

WnItF  record  back  onto  CAS  DISTRIBUTION  EUE. 

RWDIsF 

000162 

CALL  PaNACE  (rASUIS*lRECtCASDS»flCASDi IXOISFft IXDIS.2) 

RWDISF 

000165 

C 

RWDISF 

000164 

voo 

RETURN 

rwdtsf 

00016i> 

END 

RWDISF' 
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FOi^tlS  SEGTA8 

SUBHUUTINE  SEGTAH  SEGTAB 

C THIS  ROUTINE  FORMS  THE  S'EGMENT  TABLES  TO  BE  USED  TO  DETERMINE  SEGTAB 

C CLASS  SEGTAB 

C TABLES  NECCESSARY  TO  DETERMINE  CLASS  SETS  WITHIN  A ZONE  CLSTAR 

COMMON  ,/CLSTAB/  ■ CLSTAB 

1 I STRATI  300 ) » I SBSTRI 300) »NSCNT (3  00 ) , IGROUPl 300 ) , IDATl ( 300) , MODI 

2 • IDAT2(300) ,X0RD(300) , IXPT (300) » I RANK ( 300 ) t I 8PT ( 10 ) , lEPT(lO) tMODl 

3 MAXCLS t ICLCMT, ISUBItNAGO  CLSTAB 

DIMENSION  DATK300  ) ,OAT2(3O0)  ,RAMK(300)  MODI 

E(OU  I VALENCE  ( IDATl  ( 1 ) »DAT1  ( 1 ) ) » ( I DA  T2  ( 1 ) tDAT2(  1 ) ) , ( I RANK  { 1 ) » CLSTAB 

IKANK(D)  CLSTAB, 

DIMENSION  IGAP( 300 ) tGAP ( 300 ) MODI 

EOUIVALENCE  ( G AP ( 1 ) » I GAP { 1 ) ) SEGTAB 

DATA  IMAX/300/ ,XCON/10,E20/  MODI 

IPT  =0  SEGTAB 

DO  5 1 = 1 , IMAX  ■ SEGTAB 

IGAP ( I ) = 0 SEGTAB 

XURD ( I ) = O.O  SEGTAB 

IXPT ( I ) = 0 SEGTAB 

IRANK( I ) • = 0 , SEGTAB 

5 CONTINUE  SEGTAB 

ICT  = 1 ' SEGTAB 

00  30  I=ltISUBl  . SEGTAB 

IF(MSCNT(I)  ,E0.  0)G0  TO  30  SEGTAB 

ITEM  = NSCNT(I)  SEGTAB 

. DO  15  J=ltITEM  SEGTAB 

IPT  = IPT  + 1 SEGTAB 

IGAP(IPT)  = IDATI(I)  SEGTAB 

IKANK(IPT)  = IDAT2(I)  SEGTAB 

15  CONTINUE  SEGTAB 

IXPT(  I ) = ICT  '■PGTAB 

ICT  = ICT  + NSCMT(I)  SEGTAB 

30  CONTINUE  . SEGTAB 

SUM  =0.0  ' SEGTAB 

DO  35  I=ltlPT  - SEGTAB 

DAr2(I)  = GAP ( I )*S0RT { RANK(  n* ( 1 . - RANK(I))1  MODI 

SUM  = SUM  + DAT2(I)  ‘ SEGTAB 

35  CONTINUE  ' SEGTAB 

DU  AO  1 = 1, I PT  SEGT AB 

RANK(I)  = DAT2(I)/SUM  SEGTAB 
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XORDI I ) = RANK! I ) 

SEGTAB 

40 

CUNTl NUE 

SEGTAB 

DU  45  1=1  ♦ ISUBl 

SEGTAB 

IDATI { I ) = IXPT( I ) 

SEGTAB 

45 

CONT  INUE 

SEGTAB 

DU  50  1=1, IPT 

SEGTAB 

IXPT ( I)  = I 

SEGTAB 

50 

continue  ■ 

SEGTAB 

CALL  SORTAC( RANK , 1 , I PT , I XPT ) 

SEGTAB 

DU  55  1=1, IPT 

SEGTAB 

GAP ( I ) = 0.0 

SEGTAB 

55 

CONTINUE 

SEGTAB 

IPTl  = IPT  - 1 

SEGTAB 

DU  60  1=1, IPTl 

SEGTAB 

GAP(I)  = RANK(I+1)  — RANK(I) 

SEGTAB 

60 

CONTINUE 

SEGTAB 

IRK  = 0 

SEGTAB 

XMlNS  = XCOM 

SEGTAB 

DO  90  1=1,  IPTl 

SEGTAB 

65 

XMIN  = XCOM 

SEGTAB 

DU  80  J=1,IPT1 

SEGTAB 

II-(GAP(  J)  .IT.  0.  )GG  TO  80 

SEGTAB 

IF(GAP(J)  .GT.  XMINIGO  TO  80 

SEGTAB 

XMIM  = GAP ( J ) 

SEGTAB 

IMPT  = J 

SEGTAB 

80 

CONTINUE 

SEGTAB 

IFIXMIN  .ME.  XMIMSURK  = IRK  + 1 

SEGTAB 

XMIN'=  GAP (IMPT) 

SEGTAB 

GAP ( IMPT ) = ”10 . 

SEGTAB 

IRANK(IMPT)  = IKK 

SEGTAB 

XMINS  = XMIN 

SEGTAB 

-90 

CONTINUE 

--cr.TAB 

100 

RETURN 

SEGTAB 

END 

SEGTAB 

28234-6029-RU-51 
Page  501b 


P FLT  StTPRf jVOltt  t 1 


OOQOOl 

SUdROUTTNF  SFTPRF  (I2fO 

SFTPRF 

000002 

c 

SFTs  the  print  flat.  PRINTF  TO  PRINT  REPORTS  OR  SUPPRESS 

sftprf 

ooooni 

c 

print  IN(.  FOR  A GWFN  MnoOLF.  OLPtNuING  UPON  THE  ITERATION  NUHlitRSF  1 PRF 

000000 

c 

AKn  THF  INPUT  PR  I Ml  FLAG  FOR  THAT  MODULE 

6F IPRF 

000005 

c ' 

sftprf 

000006 

c 

INPUT  PaRaMETLR  •... 

SFU’RF 

000007 

c 

TpR  c 0 TO  PRINT  RfPORTS  ON  FIRST  AND  1 AST  ITERATIONS* 

SF IPrF 

OOOOOB 

c 

ipR  = 1 tu  print  rfpokts  on  every  iifration* 

sftprf 

000009 

c 

ipR  = 2 TO  PRlNl  reports  ONLY  ON  THE  LAST  ITF-RATtONt 

Sf IPRF 

00001  0 

c 

IpP  = 3 TO  SUPPRESS  PRINTING. 

SF  IPRF 

0000!  1 

c ' 

SI IPRF 

0O0012 

> c 

common  gi.ock  off  tnit  ions 

SF 1PkF 

0000)5 

c 

COUtRUI.  parameters  t or  LEM  PROGRAM 

LNIRL 

000010 

COMMON  /CNTRL  / 

LNIPL 

noon  1 b 

1 PRJnTF  *.‘^SrARTfS£FO(  !> 

CU1RL 

00001  6 

INTFGF'r  PRInTF 

LNIRL 

000017 

DOUHLF  PRFCISION  seed 

LMRL 

000010 

c 

CK'tRL 

0 0 0 0 19 

c 

1 EM  CONTROL  CARO  INPUT  DATA 

LF  hCM 

000020 

COMMON  /I EMCM  / 

LFMC-M 

oooo? J 

1 TlTtfltO)  tICASF  iCUNTHYfNTRIAL.RSTARTilPRINTtSTARTRtSTAKTi' 

LI  MFM 

000022 

2 tFNfM!  - *ENd2  .I-STG  ,’1CANS  *IYFS  .IACO  i I CL  ASS,  I St  X t *ISCL 

Lf  MCM 

000023 

3 ,ICAs2  ,ICaS3  ,IPHCAH,lPRYEStIPRCAS,IfSESG,ICSECh,ICSESH*rCStCt 

LFMCH 

0O0O2O 

4 t tCSEYH,  irsEoF,  iCSEAL.RStFOl  ,R5Etl)2,RSt  t()3,F5FtD4,RSEEU5*P6Ft06 

LI  MCM 

000025 

5 ,RSEtO/,iCSFST,  ttStr.O,  ICSEYS  * f CSECU,  ICSFCD 

LFMCM 

000026 

OTMFNSiOri  P5FEOC7) 

lfmcm 

00002/ 

OOUPLE  t’RfClSlOM  kSLFO  , RSEEIH  , RSt F 02 , RSELOi , RSEE 04 , RSFlOb 

LFMCM 

000028 

1 *RSFeD6,PSECu7 

lfmcm 

000029 

EOUIVAIFNCE  ( RSFl OtRSFhOl  ) 

LFHCH 

000030 

INKGFH  R3TART  ,STARTR,slAHr/,ENOR  tENOZ 

LF  HCM 

000031 

c 

lfmcm 

000032 

c 

STatTSTICaL  information  for  LEM 

S1  ATS 

0000^3 

J 

COMMON  /St  A IS  / 

stats 

0000  iO 

1 ITFR  ,NSEGTR,NLAHSN,NYtSk  , NRF C ( / I , NC ASCR , NC ASDR 

STATS 

0000  ^5 

tOUTVALlNCE  ( M 1,1  TUI)  ) ■ 

STATS 

000036 

c 

STATS 

000037 

c 

sfiprf 

000038 

c . 

iniLAor  ...  call  sftprf  upr) 

Sf  tprf 

000039 

c 

SETpHF  IS  called  FROM  THE  LEM  DRIVER 

SFTPRF 

0 0 0 0 0 0 

c 

S(  IPRF 

OOOOOl 

SF  U’rF 

000002 

c 

SF  TPRF 

0000O5 

Sr IPRF 

000000 

c 

initially  turn  print  flag  off. 

SI  IPrF 

000005 

PRIMIFa  0 

sr  TPRF 

000006 

c 

Tfc  S)  INPU1  PRlHt  -flag 

SI  IPrF 

000007 

IF  { TpR  .LO,  3 ) GO  TO  90 

sftprf 

OOOOOfl 

IF  / TpR  - 1 I 1 0, .30,20  ' 

sfiprf 

000009 

c 

IPR  s 0.  PRINT' UN  first  AND  LAST  ITERATIONS  OF  THIS  RUN 

SF 1 PRF 

ooooso 

io 

IF  f lllR  .FU.  MSTART  ) GO  TO  30 

SflPRP 

OOOOM 

c 

IPR  i:  2 (jR  IPR  3 0,AN0  NOT  FIRST  IIFRATtUN 

SI  tfur 

000052 

?0 

IF  ( IltR  ,NE,  NIRIAL  ) GO  10  90 

SI  IPRF 

000053 

c 

■ IPR  s 1 UR  IPRs  0 AMD  FIRST  OR  LAST  ITERATION  OR  IPR  s 2 AND 

SFTPRF 

000054 

c 

t.A.sr  iteration 

SF  TPRF 

000055 

30 

PRlNUa  1 

Sf  TPrF 

000056 

9o 

R1  lUHW 

sfiprf 

00005/ 

LUl'l 

SI  IPRI 
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P b'LT  SGE:xT;1,760'<?/»  Ssifb!  » i 


OOOOOt 

OOOOOd 

000003 

oooono 

OOOOtiS 
000006 
000007 
000008 
00000'S 
00001  0 
0 0 00  I 1 

nooo ! «2 

0 0 0 0 1 3 
0000  H* 
oonois 
000016 
0000)/ 
000018 
000019 
OOOOPO 
0000^1 
OOOO?.’ 
OOOOP3 
OOOOPO 
OOOOPb 
OOOOPO 
OOOOP7 
OOOOP8 
O00OP9 
000030 
0000  31 
000035 
000033 
00003*1 
00003b 
0 0 0 C ' 6 
000037 
000038 
0000  4‘? 
060000 
000001 
000002 
000005 
OOOuOO 
OOOOO'i 
000006 
00000  / 
OOOOOO 
COOO'09 
OOOObO 

nooo'.i 
000012 
OOOObi 
00 0010 
00 001b 
000016 
0000'^/ 
OOOO'iO 


c 

,c 

c 

c 


c 


c 

c 


c 


c 


c 


c 

c 


SU8R0UT1NF  SGtXT CSf ED3» T YPE iwiN^OW* lUSF f X I) 

THIS  SUHhOUTINE  CALIUlATtS  THE  S18NATUKC  EXTENSION  FUROR  FUR 

orutrary  segments.  ' . ■ 

COMKON/CAHERH/  COUNPt  1RfU2»  U0NF2t  ISTRA2»  1SIJ82»  TSFG2* 

1 PW(3,0)  ii)FRR(3«0)  ,SlGFKR<3f  OJ 

COHMUN/ TRAINS/  1 0UN7 . 1 Ml  07 1 1 ZONE 7 f TSTR  A 7 1 1 Sl)87  rl  SEG  7 » 

1 TIN|N(0,25) f inuTfTMH(3f0tPb)*T88(3t0,2b) ,TVV(3fOf2S)f 

J Tl'TrtUE.T  IZIJUUO)  t iPtSHin  iTPFRRCO)  , i'ERTOT  (3)  .THC3)  »TV(3l  tTfl(3) 
■ lHTF(,rR  riZULlI 
OTMFNSimi  1TRA1N(1^9) 

EfJUIVAl  FNCtUTHAlNiCUlIN?) 

CDMHON/SIREX/CODNI. IHFG1tIZnNFbi2H(3f ?3  f ZSK,(3j2»6) 

OON'rRUI  'PARAHKTtRS  FnH  LEU  PROGRAM 
COHMUfI  /CNTRI  / 

1 PHltiTF,NSlA|<r.StF0(7T 
INUCfR  PRTMF 
OOUHLF  PRFCTSION  SFF.O 

FA'IS  CnUTRClL  LAI<()  INPUT  D.ATA 

COMHuN/CAHSCH/  THOulLf IHUU 1.1SIGFX»1SKIP»ITMAX«1REP»IH1N0» 

1 lf;ROuP(i,?i  lb)  »HS(3.2f  3)  »G(3»2*2)  ,)l(3t2.2) 

HFAL  MS 


STGFXT 

STtFXT 

STGFXT 

SIGFXT 

SIGEXT 

CAllFRR 

CAhf  kR 

TRAINS 

TRAINS 

TRAINS 

IRAINS 

TRAINS 

TRAINS 

SIUFX 

CNTRL 

CNTRl 

UNTRl. 

LKIRL 

LMTRl 

LHTRL 

CAhSCM 

LAHSCM 

camscm 

LA  MS CM 
LAMSCM 


CtmMON/FRROR/TlTL('l)  iTOATFjPtSTIHtTnT.ALOCAl  *IRT0T(3)  • ERROR 

1 ♦LI'bIAS(3)  tF.PRANDC  3)  , Cl  T OT  ( 3 ) » CL8 1 AS ( 3)  »CLPAND(3)  »OtLTAt  ERROR 

1 CRUId*  Z(3,?)ihULT(3)in8»THAlNA,TRAlNU  ERROR 

UiMF'NSiON  IFRS  (00)  ' ERROR 

eouivalfnceft.i  fl  j iers)  error 

REAl  Mijl  I ERROR 

iHTrOFR  TtDfLRUPU  ERROR 

AHnuFENT  I.IST  FOR'  KKRUR  PROCESSING  AR(,LST 

COKMUtr  /AHOLST/  ARGL&T 

1 NIRrS  tNF ATALfMPFRRS.NARG  »ARC(lO)  AROlST 

OIHFliSlON  TARCdO)  * AROEST 

EOUIVAlFNCE  ( TAHGtARG  ) ARlU  bT 

APGLST 

OOUMLF  PRFLISION  SF.ED3  SIGFXT 

INTEGER  lYPFf  HTNQUW  , , • .blGf.  XT 

UlMDJSiON  V(2l  ’ bl(,rxT 

SIG'-ArpWCTYF’E’WINOUW)  ♦ AR$  C TFRTOT  t T,yPE ) ♦ I S I GF.  X^ZS  1 G C T YPE f I » lOSE ) SIGEXT  ^ 

1 +n-ISir.t  X)  VSlC(TYPE.f2»U)SE))  ' su.rxT 

XPAPsPht  lYPi'fWlNOOhlt  (1.  f TEHT0T|<TYPE)  ♦ZGCTYPEfl)  f Zt)  C T YPE 1 2 ) ) SlGFXT 
CALI.  t*E;TAI)(Sbr))3tXUARtSlGMA»Xlf  n»TEKJ  SIOCXT 

NAKf:=l  ■ . ‘ STGFXT 

IAhO(})  = IFR  SU,E"XT 

IF(ILR.GT.O)  Call  ERHHE.S(OHCAHSrbH8GEXrfO»0)  ’ SIGEXT 

lFlIER.r.L.3)  XI=XI'AR  SK.fxT 

SIGEXT 


COMPUTE  (-RKOR  RFRORT  OUANTHIFS  bTGFxT 

10  COnTINeiF  • SlGFxT 

IE  (PRIhTE'.EE  .O.OR.lREP.U.O)  RETURN  ■ SIgExT 

V(n  = 0.  ■ . ' SlGf'XT 

V(2)=0.  SIGFXT 

ir (SIGmA.I  fc.O.)  GO  TO  2P  ■ • SIGFxT 

IF  UbTi,l  X.GI  ;l)V(|  ) = (XI-XnAR;/{Ph(TY('FtRiNGOHmCRTorCTYPF))  SIgExT 

I1'(  TOlGf  X.LI  ,fl)V(?J  = (Xl-XHA«)/l*HUYPt»HlNOOW)  blGl  XT 
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0000«i9 
000060 
000061 
00006ii 
' 000'065 
,000060 
000065 
000066 
00006  / 
000066 
000069 
000070 
000071 


>0  contihuf 

z(rYi*f  ,i)=Z!»(TYPt:ti)+v(0 
■ 2(tYPH,?)'=ZU(TYPtt2)+V(?) 

tKT(lIfTYPF)a7Fr<T0T(TYPtl»  Z(TY>F»t)  + ZCTYPEtS) 
eK01A.S(7YPL‘3  = TM(TYP6  )»T|<(TYPL)*ZU(TYPF*  I) +2»(rYP»if  2) 

. tPhANI>(TYPh)  = Tn(  I YPF)t  CT  YCTYpf)  ♦ZBCTrf’ti'n  + 1 H C T Y Pt ) ♦ V ( 1 } 
• 1 +TV(TVPF)YV(m  + V(?) 

CL70T(iYPF)  = ( rutlYPt  )MVCTYPL))*Z(IYPrt  !)'  +Z(TYPEf2) 
Cl-bTAS{TYP!;)  = rH{l  YPn»ZP(TYPLi  1)  +Z(UTYPtt21 
CLKANn(7YPL)=IV(IYPF)»ZnCTYPbi U + [ D CT YPt 1 ♦ V ( 1 ) 

1 +TV(TYPt  )yV(  1)  +V(2) 

RFTUIUi 
: ■ tMIJ 


SlUFX.T 
SUllXT 
SI or XT 
SIGFXT 
SlbFXT 
SJOI XT 

siorxi 

ST6f xT 
S16FXT 
SII;FXT 
SiGFxT 
SIGF.XT 
STOFXT 
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. o riT  STAHTi )t7604?7,  39032 


000001 
000002 
000003 
00000*4 
000005 
000006 
noooo  / 
000000 
000009 

00001  0 
OOOOt  1 
0000)2 
0000)3 
0000  1 4) 
0000)5 
0000)6 

0000) 7 
oooO  1 u 
000019 
000020 
000021 
000022 
000023 
00  0 024) 
000025 
000026 

00002  7 
000026 
000029 
000030 
000031 
000032 
000033 
000030 
000035 
000036 
000037 
OOOO  3(1 
0000.39 
000000 
000001 
000002 
000003 
000000 
000005 
000006 
0 0 0 0 'I  7 
00000(1 
000009 
000050 
0 0(1  (i'l  1 
000052 

001) 053 
000050 
000055 
000056 
00  005  7 
0 0 0 05!) 


» 1 


SUB1^0l)TtNF  STAHT  STAt?T 

C ••  JOH  IWITIAU7ATI0N  ROUTINE.  INITIALI7E5  STOKAGn  FLAOgt  START 

c counters*  FTC,  start 

C START 

c-  common  (JtOCK  ofkinttions  start 

C AROuMENf  list  for  ERROR  PROCFSSING  ARC) ST 

COMMON  /AH(.l.S.T/  Af'Ul.ST 

• 1 NLRRS  -,NFArAl.tNRFKRS,NARG  tARGClO)  ARC)  ST 

DTMENSIUN  lARG(lO)  AROLST 

EOUIVAlFNCE  ( lAFOtARG  ) ARC,)  ST 

' c'  ■ ■ . ARGLST 

c rONlRO)  PaRAMLTERS  for  LFM  program  CM)RL 

COMMON  /CNTRl.  / fNTRL 

1 (>R)NTF,NSfARI,5tE))r7)  LM)PL 

IHfFOlR  PRInIF  ■ • CN)RL 

OOUHLF  PKrCiSlUM  SEEO  CfURL 

C ’ CNIRl. 

C’  constant  OUaNTITIES  for  UfH  PROGRAM  CONST 

COMMUN  /(.ONST  / ■ CONST 

1 NIRH>?  *tlAXR  *Ha2  ,IHXSEG>FNnFIL*ITSrG  LOnST 

C - Cf.NSI 

C file  UHINIIION-;  AMD  RECORD  LENGTHS  ULFG 

COMMON  /HIES  / MLFS 

1 SEGID  ,l.SbOlD*CR0PW  , L CROPW * SUOHS T * L SUHH  ♦ACOUIStLACO  Ml.FS 

2 tCAMs)  ,LCaMSF*CAMERR,LCAMLR*CASF  tLCASF  tYESOU)  *LVESO  FRES 

3 *S[r,£  XT,LSlGEX,Yt  :>ERR,LYESER*SEr.TRU*LSLC)RfrASDTS*LCASD  ) U.FS 

(4  fl.'iF*  *0)1)1’  *Trt)0  iLTACiJ  fCASOSF  tl  CASDS  MLFS' 

IHIFOEr  SEGID  ,LRI)FW  ,ROHHSr,ACuUIStrA«SF  *CAHFKR*CASF  *YES0UT  fRFS 

1 *SIOFxT*YEStRRf5F6tRll*rASDlS*OU)P  ,TACO  .CASDSE  HLES 

C mlfs 

C ttP  CONTROL  CARO  input  OATA  . IfHCH 

COMMON  /) EMCM  / LF  HCH 

1 TITiF(lO)  *TCASF  , CUNTR Y ♦ NT R i AL * KST AR T * I PR  I N T ♦ S T AR T R t ST ART2  iFnCM 

2 *FNOk  *EN1)7  *tsrt.  ,ICAMS  tIYF.5  *IACO  * ICl.  ASS*  ISEXT  tISCC  LFIiCH 

3 *TLA;,2  ,1CAS3  * Il'Rt  AM,  IPRYeS*  IPRLAS*  ICSFSG*  ICSECri,  ICSESM*  ILSFCE  LF  HCM 

4 * iLSEYUtirsESF;.  ICStAC,R3EE01  * RSEt  D2 , R5EE03  * RSE  EDA  * KSEE05  , IJSF  t D6  LFMCM 

5 *RSF  f n 7,lrSFST  , ICStlcO,  KSFYS  I ICSECU*  If.SFCD  LFHCH 

DTfllNSjdN  RSEtD(7)  LFhCH 

DOUi’LF  PRFUSIUN  RSEfD  *HSEED1  ♦K$£F0?*R5Et('3*f<SEED')*  RSEEPb^-  LFHCM 

1 ,!(SF  f D6,RSEEU  7 U MCM 

■ EOUIValFNCE  ( RSEED.PSFEIM  ) UMCM 

IMIFC.FR  RSTAHI,STaRIR*STARTX*ENDR|  *FNDZ  LFMCM 

c I LFHCH 

C page  eject  control  PaRAHFTFKS  for  I EM  PAGF;cM 

COMIIIIN  /PAGECH/  PA(,FCH 

) Nl-'AcC  ,NL:NE  ,HXt  INE.NS)  TL  , SORT  TL  ( 1 0 ) ‘ PAOFCM 

■ c ■ ■ ' pagf'ch 

c statistka)  informatton  For  llh  stats 

COMMON  /STATS  / STaTS. 

' 1 TTrr<  ,NSECTP,NCAMSR,NYESR  *NRFC(7)*NCASCR,NCAS0R  stats 

LOUIVAL)44rE  ( N1,ITFR  ) STATS 

C • stats 

c start 

C IIMkAGF  CALLFD'i  UY  LEM  DRIVER  ' START 

■ c ' START 

c start 

Nr*iTL=  n start 

• c start 
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O.OOOS9 

000060 

000061 

000062 

00006i 

00006^ 


tlO 

c ■ 


DO  UO  1 = 1 » 7 ■ 
N»Er(T)c  0 

continue 

hktuNn 

ENi) 


6TART 

start 

START 

start 

START 

start 
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0 tLT  STGt  1 t760<l^0t  *50lo'> 


t 


J 


000001 

• SUtf'UlUTltJF  S|G 

stg 

000002 

C 

StCurNT  ThUTH  generator  for  the  LEM  PROGRAM 

STO 

OOOOOi 

c 

stg 

OOOOO'i 

c 

KEAliS  DAtA  FROM  Tt’E  SEGMENT  10  FILE  ANO  TKt  SUBSTRATA ' HISTtlRICAl  STG 

OOOOOS 

c 

FILE.  €Al  CUL-AIES’ the  T«UE  Ph  AND  TRUE  PM  FOR  fcALH  SEGMENT* 

stg 

00000b 

c 

ANO  generates  the  Str.HBNT  TRUTH  FllE 

S>TG 

000007 

c 

STG 

oooooo 

c , 

nL.sioEs  The;  two  thput  files  (segid  and  suohstj  the  eoli  owing 

STG 

000009 

c 

ouantities  are  inputs  to  STg  ... 

stg 

0000  1 0 

c 

ICAgE'  a CASE"  NUMuFR 

stg 

nooo)  i 

c' 

CUMtRV  =:  COUNIRT 

stg 

00001^ 

' c 

NIRIAL  = EINAL  monte  LAHLO  ITERATION  FOR  THIS  HUH  ■ 

STG 

OOOOli 

c 

RSTaRT  = INITIAL  MONTE  CARLO  ITERATION  EOR  THIS  RUN  - 1 

stg 

ft  0 0 0 1 '1 

c 

ctarTr  a stariikg  region 

stg 

ft  0 1)  0 1 i> 

c 

START2  = STARIIiiG  7C,'(E 

SlG 

0000 lb  ' 

' c 

ENDH  s LNilTNG  region 

STG 

0000  1 / 

c 

FHOZ  = ENUING  70NE 

STG 

0000  18 

c 

IbTG  = SEG'HNT  truth  OPTION 

STG 

(100  01V 

c 

• SO  10  VaKT  SCGMEfll  TRUTH  ERROR  ON  EVERY  ITERATION* 

STG 

0(1  o(i;>o 

t 

■=1  TO  HOID  LRHOK  CONSIANT  HY  PFRFORMINfl  CAl.CULAItUMS  ONLY 

stg  ■ 

000021 

c 

UN  THE  FIkST  IIERAIIUN* 

stg 

oooo?(; 

■ c 

=i5  TO  ELIHINAIF  SEGMENT  TRUTH  ERROR  (IRROR  IS  2FR0) 

STG 

000025 

c 

SF(.MENT  truth  EiLf  WILL  BE  WRITTEN  ONLY  ON  THE  FIRST 

STG 

000020 

c • 

iteration  if  istg  = I or  3 

STG 

000025 

c 

STG  SHOULD  never  HE  called  IE  ISTG  b 2,  , 

STG 

000026 

■ c 

. iTFi?  = MOrjir.  CAkio  iteration  nUHHER 

stg 

00002/ 

c 

PRTnTE  = RRINI  El  AG  r=l  TO  PRINT  REPORT*  =0  OTHERWISE) 

STG 

000020 

c 

SLF0(l)=  RAhOOP  NUMUER  5FED  FOR  StGMf NT  TRUTH 

STG 

000(1.29 

c 

stg 

000050 

c 

THF  FULLOhING  output  UUaNMTIES  are  STORFO  in  common  by  STG  .. 

.STG 

000051 

c 

Nwrcn/s  NO.  OF  data  records  processfo  by  stg  from  sf.gto 

STG  • 

000052 

c 

NKrc(!)R  NO,  OF  data  RFCOROS  PROntSSFtJ  BY  SIO  FROM  SIJbHST 

STG 

000055 

NSFgTN  = NO.  OF  RECUROS  wKIlTEN  ON  THE  SEGMENT  TRUTH  FILE. 

STc 

0000  59 

' c 

stg 

000055 

C ■ 

COMhOA  block  deeiniTtuns 

stg 

000056 

c 

argument  list  for  FRHOR  processing  , 

arglst 

00005 / 

COMMON  /ARGLST/ 

ARt.LST 

000038 

1 NERrS  *NEATAI.  *NPl  RhS.NARG  *ARG(I0) 

ARUIST 

0000  59 

dtmfnrion  lARonoi  . 

arglst 

OOOOftO 

EOUJVAlH'FE  ( IARG*ARG  ) 

ARGt  ST 

OOOOftl 

■ ‘ c'  ‘ 

arglst 

000002 

c 

COMtROE  parameters  for  L'EEt  PROGRAM 

CNTRL 

000005 

COMMON  /GNTRL  / 

cntrl 

oooooo 

1 PRINT!  ,Nr'IAKT*SEEOC7T 

CNTRL 

000005 

INTFGIR  PKIidE 

CF-IIIC 

0 0 0 0 0 6 

DOUHLF  PI'ECISlUN  seed  ' 

cntrl 

000007 

c 

cntrl 

000008 

c 

constant  (IUamTITIES  fur  LEM  PROGRAM 

CONST 

000009 

COfiHUM  /CONST  / 

CONS  I. 

0 0 0 0 ‘i  0 

1 MIRhX  »MAxR  *MAXZ  ,IMXSEG*ENOFlL.nSFG 

CONST 

0 0 ft  0 M 

c 

const 

000052 

c 

FILE  OFF  INI  HONS  AND  RECORD  LENGTHS 

E ILFS 

000055 

COMMON  /FIlES  / 

FILES 

000059 

1 SL(.ID  tLSLGIl)*CI<OPw  ,LC«m'W,5UliM3I  ,LGUBH  *AU)UIS*LACO 

E iLf  S 

000055 

2 *CAHSF  ,LCaMsF,CAHERR,LCAMER,CASF  tLCASE  * YESOUT . L YESO 

E ILFS 

000056 

5 .SIGkXT  .LSir.f  X.YESEf?R,LYESER*SFGT!?U.LSEGTRtCASOIS.LCASO 

FIlFs 

00(1057 

ft  ilMp  ,0IHP  tiAC'T  ■ tllACu  tCAftOSE  .1  CASUS 

EILI'S 

00n058 

, 

jNTroiR  SKUO  iCRuPw  ,suii(isi  iArunir),rAMSE  *cAMERR*rASF  *YFsnuT 

Fu  rs 
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0000‘i9 
0U0060 
000061 
000063 
OOOOfii 
00006« 
OOOOOb 
000066 
00006  I 
000060 
000069 
000070 
000071 
000072 
000073 
000070 
0OO07b 
000076 
000077 
000070 
000079 
000060 
0 U 0 0 6 I 
000062 
00006i 
000069 
OOoORb 
60006(> 
00 00 6? 
OOOoRfi 
000069 
000090 
000061 
000092 
000095 
000090 
00009b 
000096 
00OQ97 
00009(1 
000099 

oonioo 
OOuiCl 
000  102 
000105 
000  1 09 
000105 
000106 
000107 
000  loa 
000109 
000)  10 
(1 0 (1 1 1 I 
000112 
oooili 
000119 
0 001  lb 
0 0 0116 
000  1 W 
0 0 0 1 1 (I 


1 *STOf »YES£RH»5FC;TRU»rASOfSfOUTP  rTACU  tCASOSF  HLFS 

MLFS 

I tK  (OHIPCL  CARD  INPUT  DATA  Lf  MCM 

COMMON  /LEHCH  / LFHCM 

1 TITlI (10)  tlCASF  ,CUNTR'YtNTRIAL»KSrARTtIPRlNtfSTARTR»STARTZ  LFMCM 

2 fFMDR  ftNoZ  tfSTO  tlCAUS  tlYFS  ♦lAC.f)  1 1 CL  ASS  f 1 St  XT  tlSCC  LThCM 

5 tlCAsP  tiCASS  flPRCAM,lPRYtS,lPRCAS,KSrsr.f  ICStCR«lCSF6H,rcs£Ct  LFMCM 
9 * ICStjYHi  irsFSEt  ICStAC»l<S,tEDl*RSEE02.6S£.E0$iPSetr)9,H5LeL>5fR5E£.06  LFHCM 

5 fPSrE07tlCSF5TiICStC0,lCSEYStTCStC0iICSr,CU  LFHOH 

OTHFNsilPN  RSFtO<7)  LFHCM 

onUHLF  F'HFCISION  MStFO  t RSEfcOl . RSEEO? » RSEE0  3 * RSEE09  * RSEt  l)b  LtHCK 

1 tR6F|;r'6,KSEF0/  ‘ LFHCM 

tout  VAlFNCL.  ( RStEOfRSFLOl  ) . LI  MCH 

INlFCr^  RSTARf  iSTaRIRiSTARTZiENOR  ,tNt)Z  LI  HCH 

LChCm 

PA6E  EJECT  control  PaKAMEIERS  FOR  I EM  PAC.FCi 

COMMON  /PACICM/  . PAOCCF 

1 NRAC.F  ,NHNF  fHXLlHt,NSTTL  iSLHIITlCIO)  PA(,tCl 

PAGfCl- 

statistical  information  for  LEM  STATS 

COMMON  . /SfATS  / ' , STaTS 

I 1IH7-  ,NSEOTRtNCAMGR,NYESR  t NRFC ( / ) » NCASCR *NC ASUR  STATS 

tOUlVAlFNCL  ( NTflTER  ) STaTS 


data  for  SEGHLNT  IRUTH'OENEKATOH 
COMMUd  /'STooTa/ 


COOm 

fSLAT 


■IZONE  tlSTRATTlSOUS 


tllRAlNtirSPRl <6) 


tSlOHG  *GR70NO,ISR  ■ tCOUN?  iIREC.2  1 1 Z0NF2*  I STRA2 


rI6'JjiS2rlJStO  floStn  ,l.RPNO  fUlSTPW.ARFA 


1 fNA  fUFLiPHf OLLTPM.CVl 
1 ?PHAi  fAVtPW  tSUHHM  ,SNhR 
S tSlfMA  «LRRPhT 
DlntwriON  loStG(lbO),  F’><(1'5 
INTFGIk  c.ridmo.crpno 


»CV2  »CV5 
fPMHLANiPw 


tNAGR 

tPWKt 

fERRPR 


F’-^ClbOlt  PM(lbO),  t'«FVPV.(  150) 


I OCaL  VAUlAljItS  5Tl. 

name  = ALPHAtllJMFRIC  FILENAMF  FOR  THE  SEGMENT  TRUTH  FILE  STG 

ttOSiD  = RFAO  flag  For  SECIU  ( = 1 to  skip  RFADING  SEGIO  'fOR  STG 
OUL  PASSf  0 OTUERHISl.)  STG 

E-TDO  = ENo-OF-DATA  FLAG  { = 1 KHEN  THE  END  OF  OAU  13  * STG 

OEIRTEO  on  SFGlD  AND/OR  SOIUISI)  STG 

FISFgS  « NUMF'.ER  of  segments  found  on  IHt  CURRENT  SUHSlRATA  STG 
(Should  = NsEGi  STo 

nRRORc  CRRUR  FLAG  RETURNED  FROM  SUltF?,  tlfTAl)  STG 

71  Ro  = 7CRU  WOKO  UGF'O  TO  FILL  OUT  SHORT  RFL0RD8  ON  SLGTRU  PIUMG 
Nl  TI.L  = MUHUFR  of  w0F!US  RLOUIRED  10  FILL  OUT  SHORT  RECORDS  STG 

STG 

linkage  ...  CALL  STO  STC 

;ITG  IS  called  from  iHfc  LEH  DRIVER  STG 

STG 

3UHF(OUTINES  UsFO  ...  STG 

GMAD  a m.lA  DISTRIDUT  TUN  ROUTINr  STG 

FRKFFES  = FRROR  MEPSAGF  ROUT  INK  • STG 

STG 

IIIeNAHE  F'0f<  SEGMENT  TRUTH  FtlF  ' STg 

OIHF'NlllON  NAHtf,.')  STG 

DATA  NAMF  / 9HSF.ni  t9HRUTH  /»XtPO/0/ 

S T G 


1 
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000119  • 

C ' 

STG 

oont?o' 

c 

, 

STC 

OOOlPl 

c 

•5KIP  HFADER  records  of  SEGHENI  ,1D  file  AMD  SUUSIRATA  HIST.  MLfSTG 

OOOIJ’2  ■• 

RfWTND  REDID 

STG 

ftooiri 

Rl'An  fsFCro)' 

STG 

000120 

KIWI  Ml)  SURHST 

* 

STG 

000  1 2b  ■ '■■  ' 

„ ... 

KFAD  (sUbHST) 

STG 

000126 

KFWTUD  Str.TRU 

STG 

000127 

c 

WRFTf-  HEADER  RFCORo  OF  SEGMENT  TRUTH  FILF 

STC 

OOOlPH 

NFIl  L=  1 blGTK  - 0 • ■ 

STG 

000129 

hRirt  (SEGIHU)  NAliEflCASEfnSFGtC  7EHUfI=l  fNUt.L  ) 

STG 

ooono 

c 

STG 

OOOJ‘41  " ■ 

c'  • “ 

IMllAU7e  FLAGSi  cOlINTERSt  FTC, 

STG 

O001‘^2  * 

N«Lr(l)=  0 

STG 

oooni 

NRLC(3)=  0 

STG 

000150 

:nSLO IF  = n . 

StG 

000155 

! KPS  ID.  = 0,'0  . ' 

STG 

ooono 

. tMDD  = 0,0 

vSTG 

0-0015/ 

1 6UMPW  = 0,0 

STG 

ooonfl- 

; H.StGS  = 0 

STG 

000  nv 

'Ht  lMf.=  MXUNE 

S T G 

0 0 0 Wl  0 

. C ■ / 

read  data  rlcoro^from  suostkata  historical  file 

STG 

0 0 0 1 0 1 

■ c ; 

STG 

0 0 0 1/12 

Pool 

y 

REAO  (sUtlHST)  C0UN2,lRhG2tl70NE2»l5TRA2»lRUHS2,MSFG 

STC 

n 0 0 1 ii  i 

1 » ( rf).Sf-G(lljI=l»IHXSrG  )|  GKPNOfHISIPW,  ARhA,PWKfNAGKfNA»DELIPH 

STG 

0 0 0 1 /10 

. 1 

2 tOEl  Tt’M»CVltCV2.CV3,CV9 

STG 

0 0 0 1 /I  b 

?Z(J 

IF  ( cOUM2  ,F0,  FNDFTU  ) GO  .TO  600 

STi) 

000106 

c : 

ARF  RLGION  AND  /ONF  FROM  bUUHST  HlTlIlN  THE  RANGE  DEIERHINEO  HY 

STG 

0001/1  / 

c ‘ 

STAkTR.  GIAHTEf  E-fJnR.  AND  FND2 

STG 

oooi/ifl 

{ 

1 

IF  f ipf-G?  - .STARTR  ) ?00,2i0,2>/0 

STG 

000  1/19 

• c . 

IMf,?  = .StAKTR,  MOW  r’OHPARE  I'/lONld  ID  STARTS 

STG 

OOOlbO 

23;o 

IF  r T7flNi:2  ,LI.  SIART2  )’  GO  JO  200 

STG 

oooisi 

C ' 

IHfG?  .GF.  6TARIR  AmD  !20/'.F2  .Gt.  SJAKT2 

STG 

000  1'-i2 

?//;o 

IF  C TnDR  ,FD.  0 ) GO  TO  260 

STG 

OOOlSi  ^ 

IF  ( I«l G2  - CMOR  ) 26n»2b0»600 

STG 

.ooono 

C , 

IRTG?  = Fl/0|<,  NOW  CnH'’A«L  1/OHE?  TO  tNO? 

STG 

OOOlSb 

^bO 

IF  ( U(1NF2  ,GT,  End/  ) GO  ID  600 

STG 

ooono 

c 

TRFG?  ,LE.  EML'R  and  T/OnE?  ,11.,  FNDZ 

< 

STG 

0 0 0 ni  7 

26  0 

IF.  f MsFG  ,TD,  0 1 Go  TO  200 

STG 

0001'5fJ 

c 

’ ADVaMCF  .SUHHSI  COUmTF'K 

STi; 

0001S9  “ 

NRECC5)=  NRrc(3)  + 1 

• 

STG 

000160 

c 

• , • 

STG 

0 0 0161  . ■ ' ■ ■ 

' c 

AHF  WE  REaOY  to  read  a SEGMENT  FROM  THE  SEGKFNT  10 

FILE 

STG 

000162 

c 

( WK  MAY  HAVE  ALREADY  RLAD  THE  FIK.ST  SEGMENT  FOR  THE  CURRENT 

STG 

000163 

c 

SUllSTKATA  m.KUHE  RFADING  JHL  SUHSTRAJA  FILE  ) 

STG 

00016« 

IF  ( PpSK)  ,en.  0.0  ) GO  TO  500 

STG 

00016b- 

c 

■'.SET  fLAG  TO  READ  SFGhEMI  ID  FILE  NEXT  TIKL  THROUGH 

THIS  loriic 

STG 

000166 

RD5ID=  0.0  ■ 

■ 

STG 

000167' 

00  TO  //OO 

STG 

000160 

c 

STG 

000169 

c 

flag  a data  record  From  tmf  slghcnt  id  hie 

STG 

000170 

300 

RFAD  (SFGJO)  COUNt IRr G , 17UNE » 15 1 RA J r ISUuS f 1 SFO» UR  AIN* ITSRRL 

STG 

000171 

1 fSLAT  *3l.Oi)GtGRli)N0tlSW 

STg 

000172 

■^20, 

IF  ( COHN  ,ru.  FMPF IE  ) GU  JO  600  ' 

STG 

000173 

c 

ART  Rtr.IDN  AMD  ZONP  FROM  SIGiD  rtlTHIN  THE  RANGE  DEIERMINED  HY 

STG 

000170 

c 

SIAkTR,  STARTZ*  fNDH,  and  ENDZ. 

STG 

000  17'i 

IF  ( It/fG  - STaRTR  ) inOi33o*J'IO 

STG 

000176 

350- 

IF  { I/ONF  ,ul'.  STARI-7  ) on  TO  ,500 

STG 

00017/ 

C 

'IH(G  ,c.l.  SUARTR  AND  1/UMt  ,GC.  STARTZ 

,stg 

0 0 0 1 7 11 

3/(0 

■ IF  r 1 t)DR  .11),  (I  ) Co  TO  /)00 

S J 1, 

60S 

00 


00017'/ 

IF  ( 7|<hG  - tM(/H  ) 4 00 » 35  Of  600 

STG 

OOOU'O' 

c 

Iflht;  = NOW  COHl’AWE  I30NE  To  tUDZ 

sTi: 

OOOIM 

350 

IF  ( IZONF  .GT.  END7  ) GO  TO  600 

STG 

nooiHt> 

c ■ 

IKFG  .lEf  ENOK  ANO  UONE  ,LE»  FNDZ 

stg‘ 

oonirii 

C 

•STi; 

0001  R4 

C 

rOHpARF  SUBSTRATA  FROM  SEGtU  TO  SUBSTRATA  FROM  SUBHST. 

STG 

ooniH'j 

400 

IF  ( TrFO  - IRU‘.2  ) 440*410,470 

STG 

0 00  U16 

410 

IF  ( IzONE  - I7()fl£2  ) 44,0,420*470 

STG 

000  1P7 

420 

IF  ( IsTRAT  - ISTRA2  ) 440*430*470 

STG 

000 inu 

4 JO 

IF  f TsOUS  - ISUHS2  T ' 440*460*470 

STG- 

000 1 

■ C 

STG 

oooioo 

c 

substrata  From  sfgiu  ' ,lt.  suusirata  from  suhust 

STG 

oooioi 

c 

SOMpTHINt;  rs  HRUNG.  THF  FUfcS  ARt  INCONStSTLNT  WITH  EACH  UTHFR 

STG 

oooio^ 

c 

t)R  oRt  file  TS  out  OF  OKOfcR.  hRlTt  tWHOH  MFSSAOE.  OROP  THIS 

STG 

oooioi 

c 

SCGhFNT  AMI)  CONTINUL, 

STG 

000104 

440 

IF  ( ItFR  *F0.  PSTaRI  + t ) CALL  ERRBES  (3HSTG*3HSTG* 1 ,0) 

STG 

00  0 lO'j 

GO  TO  300  ■ , - 

STG 

000190 

c 

■ 

STG 

000197 

c 

substrata  From  sfgiu  ,gt,  substrata  from  suuhst. 

STG 

00019U 

c 

ThF'FNO  Of  niF.  CUKRtNl  substrata  from  SUBHST  HAS  BEEN  REACHED, 

STG 

000199 

c 

SFT  FLAG  TO  SKIP  HfADlNG  SFGID  UN  THF  NtXI  PASS  SINCE  THE 

STG 

000200 

c 

first  segment  of. The  next  substrata  has  already  been  read  from 

STG  - 

000201 

c 

SI  Bin. 

STG 

000202 

470 

RI)STo=  K(1 

STG 

00020i 

GO  TO  6fu 

STG 

000204 

c 

IS  this  The  first  iteration  for  this  run. 

SJG 

00020b 

4U0 

IF  ( ITFR  .GT.  RSTART  + 1 ) GO  TO  SOO 

STG 

00020(1 

c 

first  TTFRATIUN,  tS  segment  from  slgid  in  idsfg  array  from 

STG 

00020  f 

c 

SUPIIS1 

STG 

000200 

DO  490  I=l,NSfG 

STG 

000209 

IF  ( ISFG  ,F0.  TDSFG(I)  ) GO  TO  500 

STG 

0 0 0210 

490 

CONTIHuF 

STG 

0 0 021  1 

c 

SLGkFNT  TS  NOT  IN  IU5EG,  PRINT  WARNING  AND  DROP  THIS  SEGMENT 

STG  • 

000212 

CALL  FRRFirS  ( 3FIS  1 G,  3HSTG*  2 1 0) 

STG 

000213 

GO  TO  300 

STG 

0 0 0 214 

c 

STG 

00  0 21b 

500 

PWKI=  pWK 

STG 

000216 

pHKts  pWKT*nELTPM 

STG 

0 0 0 217 

c 

test  for  ZFRO  error  case  ( ISTG  = 3 ) 

STG 

0002  1 U 

IF  ( IsTG  .ru.  3 T 00  TU  b20 

STg 

000219 

c 

Si 

STG 

000220 

c • 

COPpUTF  TRUE  PW  AND  TRUE  PM  FOR  THIS  SEGMENT. 

STg 

000221 

5lGHA=  PWK*rv2/100,0 

STG 

000222 

CALL  BeTAD  (SFtDcn  ,PW1</100.0*5IGMA,PWK1*0, terror) 

S T G 

000223 

iAKncijc  ierrok 

STG 

000224 

00022b 

irni.PROR  .RE.  0)CAI.L  ERRM£S(3HSTG,3HSTG,3,0) 
IFITERrOR  ,f  0,'  J)l’nKI  = ,Ol*pi(K 

000226 

PKHFAR=  PWKI+IHLIPH  • 

STG 

000227  ‘ 

Sl6MA=  PMMEAn*i,V3 

STG  ' 

0002211 

CALI  BfTAO  (SFFOCOfPHMFAN, SIGMA, PMKI*0*IFKROR) 

STG 

000229 

IARG(|)=  TiRROR  ' 

STG 

000230 

irUEF.'iH'K  .HI.  0)CALL  ERRMtSl3)ISTG,3HSTG,4,0) 

000231 

000232 

c 

IFOERrOR  ,ro.  3)PMK1  s PMMEAN 

STG 

000233 

puhls  ino.oM’Wnl 

STG 

00  0234 

PFIKta  100.0  + PMhl 

STG 

00023b 

c 

STG 

000239 

c 

WRITE  REfoDD  ON  SEGMENT  TRUTH  FILE 

STG 

000237 

520 

WRITE  t5{  GfRU)  LUNTRYnRFG*l70'JE*lSTRAT,ISl'bS,I3FG,ITRAlN-,  nsPRL 

STI, 

0002  <l) 

1 , 1!i1*,l’hK  I jPt'M 

STt; 

♦ NtW 


♦ NtW 

♦ NtW 
*41-4 
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«oov;:sv 

c' 

AUVaNCR  C0Ut-l!tl?3’ 

8TG 

000(J/i0' 

NStRS=  Msrcs  + 1 

stg 

00  02«  1 

N«fer(l)=  NRRCfn  ♦ 1 

STG 

0002VI2- 

usir.'n/=  h.3i.r.T9  + t 

•STG 

pOO,2/l5 

SDHPWs  SUMHW  ♦ (>HK1  . 

STG 

0002<I(< 

PH{N61r,S)=  f’rtKI 

STG 

0l)02/lb> 

PM(H6lcS)=  PhKI 

STG 

0 0 02/16 

GO  TO  300 

STG 

00020/ 

c ■ 

StG 

ooo<;/'a 

C 

rKD  OF  A S"USrRATUH» 

S T G 

000200 

c 

RtT  FNO-OF-OATA  FLA8 

STG 

0002S0 

'600 

EMOI)=  1.0  . 

STG 

0U02S1 

■ C 

« 

STG 

0002S2 

' 610 

IF  { PkINTF  ,F0.'  0 > G6  TO  650 

STG 

0002S3 

C 

COMplJlF  AVFilAGE  PW  FoR  THIS  SUBSTRATA 

STG 

00O2<-,0  • 

IF  ( tJsrGS'..tO.  0 ) GO  TO  660 

STG 

oon2‘i^) 

* 

■ SRllWs  nSLG-^ 

STG 

ooo^na 

AVH>w=  SUMPH/SfJHR  ■ 

stg 

0002S/ 

c 

ruHpine  frrmr  in  sfchent 

STG 

ooo2sa 

DO  630  I=l»NSfGS 

stg 

00  0 2<,9 

fcRKI>si(i)=  PW(T)  - PWK 

STG 

000260 

630 

CONTI HuF 

STG 

000201 

C 

STG 

000202 

c 

PKlNT^RtGMfHT  TRUTH  REPORT  DATA  FOR  THIS  SUBSTRATA 

StG 

000203 

c 

ST(, 

000204 

IF  ( Ml  INF  + NbIGtl  .LE,.  HXl.INE  ) 00  70  640 

stg 

000266 

c 

FJFcT  PAGE  AND  PRINT  HEADERS  BEFORE  PRINTING  SF&MERT  TRUTH  UATA5TG 

000206 

CALI  FjFCT  (5) 

stg 

000207 

KRITl  ((!UTP,1) 

STG 

000208 

1 

FfiRNAT  (/30X,3‘>HS  EGHENl  TRUTH  REPORT// 

STg 

000209 

1 llXfllMTRUE  PR  FORjl4Xf  UHTRUE  PK  F(lR.6,Xt7HAVERAGE*9Xf  6HERR0H 

STG 

0002/0 

2 t /X  f t tllTRUE  P8  F0R/'32H  substrata  SUBSTRATA  SLr.MFNTt/'Xt 

S T G 

000271 

5 7HSf  (-.8LNI  ,10Xf2t!PW,l2X»6HlN  pH  1 9X  t THSE'GMLNT  1 6X  ,9H  I TER  A IION)  . 

STG 

000272 

600 

CALI  PaFER  (NSlG+n 

STG 

0002/3 

’HRITE  (8UTP»2)  ISUBSPtPWK.,  IDSbO(U  t PH  ( 1 ) t AVLPW  »LRKPh  ( 1 ) f PH  ( 1) 

STG 

000274 

1 tIIFr 

STG 

000276 

? 

FORMAT  (/17fM3.4.It0.4Fl6,4,114) 

STG 

000276 

IF  ( N'SIGS  .(,0.  1 ) GO  10  660  , ■ 

STG 

000277 

HRITE  (flUTPfi)  ( ir)SFG(n»PHtl)fFHRPKn)»PH(n,l  = 2,NS£GS  ) 

stg 

000278 

■ . 3 

rO.a'AT  (130tF!6.4»  1SX.2F 

ST(, 

00O27V 

C 

IF  mSeGS  .me.  Nsro,  TilfN  PRINT  mARNINC  that  segment  IDS  ARE 

STG 

0002RO 

C 

mroHRrcT, 

stg 

000281 

660 

1ARGU)=  lISFGS 

SlG 

000282 

IF  ( MSECS  .NE.  NSEG  ) CALL  ERRMFS  ( 3H5TG » 3HSTO » 5 f 0 ) 

STO 

000283 

Nsn;s=  0 

STG 

000284 

S'UMPHc  (1,0  . 

STG 

000286 

IF  ( f nPD  ,F().  .0.0  ) on  TO  200 

STG 

000286 

C 

FNO  OF  DATA  ON  SEGID  AND/OR  SU8H5T 

STG 

00028/ 

9o0 

NFll.L=  LSFGTR  - 1 • 

stg 

000288 

NRITL  (GEC.TRU)  ENDFIL#  ( 7ERU  * 1 = 1 »NF  ILL  }. 

STO 

000289 

LND.F  II  t SFGTRU 

STG 

000290 

R(HINI)  SEGTRO 

STO 

0002O1 

IF  ( NsFGTK  .b'O.  0 ) CALI  FRRHES  {3llSICf  3HSTG,6»0) 

STG 

000292 

Ri-TMRN 

- stg 

000293 

c 

stg 

000294 

E'llO 

stg 

28234-6029-RU-00 


ti  hLT  5TGKKMtl*760'<^7t  590^6  •,  1 


OOOOOl 
000002 
000003 
000000 
oooon'i 
000006 
00000/ 
OOOOOti 
000009 
0000  10 
.0000  1 I 
0000)2 
000013 
000010 

0000  1 ‘j 
000016 

00001  / 
0 0 0 0 I !) 
0 0 0 0 i 9 

oooo?o 
000021 
nufl(i?2 
000023 
000020' 
000025 
000026 
000027 
000020 
000029 
000030 
000031 
000032 
000033 
000030 
000035 
000036 
000037 
000030 
000039 
000000 
OOOOOl 
000002 
000003 
000004 
000005 
000006 
OUOOO  7 
OOOOOtt 
000009 
OUOOSO 
OOOOM 
000052 
000053 
000054 
000055 
000056 
OOOOS/ 
000051) 


c 

c 

c 


c ' 

c 


c 

c 


c 

loo 

1 


c 

200 

2 ' 


c 

300 

3 


C 

400 

4 


C 

500 

5 


SlIUPOliTiNF  STGF-.1?R  (ICgOF)  STGFRR 

PKIUTS  tRROR  MFSSAGfcS  f:0R  SEGMENT  TRUTH  GENERATOR  STgFRR 

•STGFHR 

ARGijHENr  LIST  FOR  FRROR  PROCESSING  APGLST 

COMMON  /AHGlST/  AI'GI  ST 

1 NfcRkS  tNFATAl  tNPFRRSfNARG  fARCtlO)  AUGI  ST 

DlMCNSlOl')  IARG(IO).  , arust 

EOUTVALKNCE  ( lAROtAPO' ) APM ST 

ARGl  ST 

Flu  OFFINITIONI,  AND  RFCOHD  LENGTHS  ■ ULLS 

COMMON  /Files  / I- ills 

1 SUGlP  ,LSEGIOtrKOPW  ,LCROPWTSOHHSTfLSU(iH  t ACHUT  S » LACT  MLtS 

2 tCAMsF  ,LrAHSF,CAHLRK,LCAMtRfCASF  ti.CASF  .YLSOUI  tLVfcSO  l-Ill-S 

3 tSIOf.XTtUSlGlXfYf  SERKtLYtSeR»RtGTRUtLfitCTR*CASDIS«LCASL)  F U FS 

4 tTNl’  .OlUP  tTACQ  ,LTAC(J  . C ASOSF  *LC  ASDS  KILFS 

IMIFGfR  StGlO  ,CRi'(’W  tSUIlKST  tACUllIS»CA!16F  » C AMCRR  » f ASF  jYFSmJT  Ftl.FS 

1 fSIM  xTtYES£HKtSt'.;TRU,rASDlSfOUTP  »TACO  tCASDSF  FlLFS 

FIlfcS 

OATa  for  segment  truth  GENERATOR  ’bTUTTA 

COMMON  /SKUtiA/  STC.rvfA 

1 CONN  iIRFG  »l/l)NF  .ISTRATtlSUtlS  ♦ISEG  ■ t T TO  A I N ♦ I TSPRU  6)  SToOTA 

2 f SLAT  - »SI ONG  fOKlOMOtlSW  iCOUN?  *IRtG2  t I/0NF2 t I STRA2  SToOTA 

3 »I3UnS2tNSiG  tIOSEg  ,GPipNU  »HlSiPh,ARtA  '*PkK  tNAOR  blGOTA 

4 fNA  fOFLTpi^.Dtl  IPM,CV1  iCV2  *CV3  iCV4  iPW^t  SToOlA 

5 tPMKi  ,AVM’W  .SUtiPK  tSNOR  ,PHMEAN,PW  , PM  . ,tRKPW  STl-OTA 

6 tSlGKA  ftRRPMl  ■ , STGOtA 

DIMENSION  lOhtGdbO),  Ph(150)f  PMtl50)f  FKRPW(150)  STOniA 

INIFGFR  GRIoNO.GRPNO  • STuOlA 

• • STOOTA 

stcfhi^ 


IHtS=  .iCODE  . . STGFRR 

GO  TO  (100»2o0*300»400»500r600)t  IMES  ’ SU.FRR 

STG) RR 

HRlTt  (OUTPt  1)  iruGf  TRFG2»UONFf  IZONF2tlSTRAT.  I STR  A2 1 1 SUMS . I SURSPSToFrR 
FORMAT  (TlHOTHt  Sf GNLHI  1!)  FILL  AND  THh  SUhSIRATA  HISTORICAL  FILL  STGERR 
lARt  INcONSISTFHT/)3V,|4hSFGID  StHJHST  / 7H  KF  G 1 ON  t II 1 1 T 9/5H  Z^UNE»  SIGFRR 


2 lJjfl9/7il  SIHATA»IU»J9/11M  St'USn*AIA»I7tI9)  STGFRR 

GO  TO  oOO  STGFRR 

SIl.FRR 

WHITE  inoTPt2)  iSLGtlHFGdZONLflSTRATfTSOOS  STgFRH 

FORMAT  (VHOvStGUINT  tlSfOlH  IS  NOT  IN  lOSF.G  FROM  SURHSI  FOR  RFGIONSTor  K‘R 

1 »14»«H  t ZOnF  ,14,10M  , SIRATA  iI4»13H  t SUBSTRATA  il4/  SIGFrR 

2 5X  »2  3H0FGMFN I RlLI  Ht  URUPI'FDl  STCM<R 

GO  TO  900  SU.FRR 

STgfrr 

WRITE  (OUTPfS)  lAHGd ) ,PWK»3lOHAfPHKI  * STGFRR 

FORMAT  <40l<0fHK0R  HFtURN  FROM  UEIAO  ROUTINE.  1EH=  tl2»aH  . PHK=  SToTHR 
1 H3,6«0H  SlGHA=if  13,6t7H  PWK I = » f 1 3 , 6 ) 

GO  TO  vOO  STGFRR 

STOFRR 

WRITE  (OUTP,4)  lARCl ) ) ,PHMFAN,S1GMAiF’MK  I STGFRR 

FOHMAT(40I!OFI<ROR' return  from  HLf/.O  RUHIlNf. , IER»  »I2dlH  « PHHEANSTgFrR 
1=  »fl3.6,mt  3IGHA=ttl3.6t7H  pMKT=iE)3.6) 

GO  TO  vOO  . • STGFRR 

STGFRR 


WRITE  (OUTP»5)  IAX6(n»NSlG  STGfHR 

FORMAT  dOlinwARNlNG.  •MSl  GSs  r'lf29!(  .Nfc.  NSEG  (FROM  gUllHST)  s OT(;ri<R 
! I'l/r'vH  segment  ids  MAY  Ok  JMCORRU’T  ) STCIRR 
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oi)no60 
000061 
OOOOOrJ 
0 0 ()  0 ^ i 
000060 
00006b 
00006b 


GO  TO  VOO 

c 

600  W«ITE  fOUTP»6) 

6 ‘ format  (60H0WARNING,.. 
IRAIflK  ) 

C 

900  RETURN 
END 


STbFRR 
6TG!  RR 
STGFRR 

NO  SEGMENTS  PROCESSED  BY  SFGMENT  TRUTH  GENESTOERR 

SI UERR 

stgfrr 

6TGFRR 

STGFRR 


E8E34-6029-RU-00 
Page  513 


# ELT  SUMRt*P,'l,7fcO«27t  390<?7  t 1 


OOOOOJ 
000002 
OOtlOOi 
OOOOO^J  ■ 
OOOOOfj  ' 
000006 
00000/  ■ 
oooona 

000009 

ooooto 
OOOOH 
000012 
000013 
000019 
0 0 0 0 I'j 
0000  16 

•0000  1 / 
00001 u 

000019 
OOOOPO 
000021  . 

,000022 
000023 
Ofl002'l 
000025 
000026  • 
000027 
00002U 
00  0 029 
0000^0 
OOOO’-l 
0 0 0 0 2 
OOOO^i 
0000‘^9 
0000315 
000036 
000037 
0000  10 
000039 
000000 
00000 1 
000002 
000005 
0 0 0 0 0 9 
noooos 
00  0006 
0 0 0 00  7 

oooooo 

0 0 0 0 0 9 
0000‘>0 
000  o't  1 
000052 
000053 
000059 
000055 
000056 
000  (157 
0000511 


c. 


c 

c“ 


c • 
c 


c 

c 


c 

c 


c 

c 


c 

c 


c 

c 


SUOPlUlTtNF-  SUMKFP  SUMREP 

FL/lr-S  AND  C0UNTtR5  FOH  CAS  SIMULATOR  CASFLG 

COflHUM  /CASfl.G/  ■ CASHG 

1 H tPPfLG  »NSW  flMW  fHINi)Oh,lPl)  »IPP  fPPOATE  iNKEGS  CASFLG 

2 jM/ToT  tNMRATtNYFSSK,NSSliSKtNCAMSKtHRYES  tNHSSH  tNRCAMS  CASFLG 

3 fERDC  •tN0Rtn*END20N«lHSTH  t IH70Nt » IRHEG  CASFuG 

9 *105!  tLDS'l.  *1.05/  ,LDSfl  *t.0S9  iLDSlO  *10511  ,10512  *L0S13  CAiflG 

5 *lt)5|9  ,L0515  iL'orilA  ♦LDS17  il.HCOUN  ,LRRFG  »LK7uNt  tLRSTH  CA^f-LG 

JMTFGJ-R  .PPELG  ♦ WIRDOW  * PPOAIF  CASFL« 

CASFlG 

Flit  DFFlNiriUMS  AMO  KFCOKD  LLNOThS  . niFS 

COIIKOH  /FILES  / FILES 

1 Shr.ll)  ,LM;OID,CntiPW  ,LCR0PW,r)lJPHST,LSU6H  , ACOUIS  ?LACO  FILES 

. 2 ,CAMSF  -*LCAH3F  *r.AHtPtM,CAHLP*CASF  *LCaSF  * Y tSOU  T , L Vfc  SO  FILES 

• 3 ,SlnL'(I,L«SlC,CX,YESLRK,LYtStH,St{:iRU*t.Sl  GTR*CASOI5,LCA80  FU.F.S 

9 »TUP  ,0'lrp  YTACO  ,LTAC(j  * CASOSl  *LCaSOS  FUFS 

INIFM'P  StGlO  ,CRi)Pr*  ,SUHH5  I , AC(jlJlS,CAFbF'  iCAmF  PP,  OASF  tYFSOUJ  FUFS 

1 ,ST(/rxTiYtSFKK,SF(,IRl)*CASLiIS*UUlP  .TACO  *CASOSF  FUFS 

FIlFS 

IF.M  CONTROL  CAPO  iNPljT  OAfA  LFMCH 

COFIHOR  /I  fcllCM  / L(  tlCd 

1 TITlWIO)  jICASF  fCUNTRYTNTRIAL,RSIAHT,IPRl*;l  ,srARIR*STARTZ  IJ  (ICH 

2 tFNin?  *tNDZ  *IST6  ,ICAH5  ,IYFS  ,1AC0  , 1 CL  AS6 , 1 5 fc  XT  fISCC  I.FHfH 

3 tKAs2  ,IfAS3  *IPI!CAM,lPKYt!!*rPHLAS,ir3rsn,ICSLC.*,lCSF:6H*ICSLCt  LF  MCM 

9 , TCRp  Yh,  ICSF.3H  , rest  AC  .RSfcFU  1 * H6EtD2  * PS LFo3 , R6F  tl)U  , PSttU5  * R6Ft  06  CF  MCH 

5 ,i!6Ff07,ICSFST,ICSfcCU,lCStYS,TCSLCU,lCSrCD  LFHCH 

DIFiFRSiai.  RSf.t(»l7)  LFmCM 

DDUOLF  PPtCISlON  RStFO  ,RSELt)  1 , PStEO? t PSEt03 * PStE 09 , RSEE05  LFhCM 

1 *PSFFnf>,PSEFl)7  LfHCM 

EOUTVALlliCL  ( RSttOfRSFEoi  ) Lf  MOt 

IMlFOrp  PSTARTfSTARlRtSl APT/ftNDR  tFNDZ  . LFMCM 

Lf  HCM 

PAGfc-  t.ILCT  CONTROL  PaRAMEIEPS  FOR  LEM  ' I’AGFCM 

COIIMON  /PAGtCH/  HAC.FCM 

1 NPAcF  ,Nt  INt  *Hxl  iMttNSTTL  tSUtiULnO)  PAOl  CM 

, - PA(,rcM 

statistical  INFOPMAnuN  FOR  LfcH  STATS 

COMMON  /STATS  / STaTS 

1 ITlp  ,NSLGTR,NCAMSK*NYES»  ,NRELC7),HCASCR,NCASDP  ; STaTs 

EOUTVAlTNCF.  ( NTjITEr  ),  STaTS 

STATS 

CAS  control  CARO  INPijT  DATA  AND  CONSTANTS  CASCM 

COMMON  /CASCM  / ' CASCM 

r ARFaCF,YCF  ,1’ROCF  ,APRUTS(9,?)  ,PPR1ITSC5,2)  ,YPRinS(3*2)  CASCM 

? ,ARFaF’S,S2HAX  tNrIISTY.MH  ,TOPT  . AON  I TS  , 0 1 S T FF  421  NO  ( 9 ) ' CASCH 

3‘  *WPRlORf9)  tApliCP  ,lP!iO(S,19)  . , NI’O  A ! f * PROATE  ( I 9)  ' CASCM 

1NTF6FR  HH,  -ToPT,  AUM 1 TS  . 0 I S TF  F , ttW  I NO  * WPR  UIR  * APRKP  , PRO  AT  E CASCH 

CASCH 

summary  oaTa  'for  reports  , SUHOTA 

COMMON  /SUMOTa/  SUMOTA 


i CVAi  l'T,f.Vi.lMA,S0rtR  ♦ C VPFP  T , C VFP  T P , C SUHR  1 16 , 1 » ) SUllDTA 

suhota 

CAS  DATA  GFT  13  (COUNTRY  DATA  — SFCOnD  PASS)  OSETlS 

COMMON  /OSTTI3/  « • USE  TlS 

1 , liHAC  ,IRAC  ,FkAC  ,AFPRC  fAVARC  , TPROOC * F PROOC * PRERRC ,PR V ARC  DSFT13 

2 ,TYC  *EYC  fYERRC  ,H1C  *M2C  *CTIC  ,CT?C  tCTSC  *ANAVC  0STT13 

3 ;A'lP|<VC*(.n,WA  ,CLfPPD,Ct  ArtCCLPIFtfCI  AlNC*Cl  IMWC  ' OM  1 1 3 

lifAl  MIC  * H/C  USE  T 1.3 
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■oooQ*;9 

OOOOI^O 

OOO'oM 

OOOOf'iJ 

000063 

OOOOh't 

0000/>b 

0U00O6 

000067 

000060 

000069 

001) 0 /o 

000071 
000072 
000073 
000070 
0U007S 
00007c> 
.0000  ?7 
000070 
000079 
OOOOHO 
000061 
000062 
00006^ 
000060 
00 00 6 6 
000066 
00006/ 
000060 
000069 
000090 
000091 
oono9^ 
0110091 
000090 
0 00  09'j 
000096 
00009 / 
0 0 0(196 
1)U0  0‘>9 
0 0 0 1 0 0 
OOOlOl 
000102 
oooioi 

000  1 O'l 
OOOlOb 
000106 
000107 
000106 
000109 
0 0 0 1 1 0 
00011  1 
0 0 (1 1 I 2 
000113 
000  1 1 0 
0 0 0 1 I b 
000116 
0 0 0 11  I 
000116 


DiMtNsirON  0sFT13(25) 
enuivni  FNCE  ( 0&FT13,HWAC'  ) . 

c . , 

c . ' ■ ' 

C THIS  SUUVnl'TINF  PRINTS  iHb  CAS  COUNTRY  SUMMARY  RFPORT 
■ C 

c first  pace 

C , HfcADFRS 

CALI  l'JfCT(tJ) 

WRITfcf(.|llIP,?000)  ' • ■ 

?000  inHMAr{/33Xf9buC  OUmTRY  SUMMARY  REPOH  T//) 
KRlTt  UtUTRi3000)  CUNTrY,NT 
‘<000  format  (2Xt9HcOUNJRY  *A6»12H  JTtRATION  » 13) 

WRlIUoIMP.OOOo) 

6000  format (/12Xf lHt,16XfUHA  REA  t 1 6X r 1 HT » «X » 1 OHY  I E L 0 
1 IHt  ,6X,20t(R  RonucTION  ) 

IHUXiAllNns+l 

RRlft  f(ililPt'’'0Oo)  tAt’KiHSUf  INDX)  ,r=l  f «)  . ( YPRUT S ( 1 1 1 NUX ) » 1=  1 1 3)  t 
1 (PRRuTSdf  lNUX)tI=Ub) 

SoOO  FORMAT  f I2X  t f 1 OX  t'lAAf  6Xt  IHt,  3A6*  lHA.6XtSA6) 

FrRlTF  (uIMPt6oOO) 

6000  F0RHnT(12X,  ! H*  , 0 OX  , I lit  , t 6X  » I ) 

V.RlTt.CiilirPf7000) 

7000  FOIC'AT  C12XtlH  + tl3X,?(?MrV»«X) f2MCVt5XtlH**10Xt6HST  DEVr2Xi 

1 H'+»  l?X»3(2l'C7,eX)  ) 

WRITfc  fuOTINBoOO) 

6000  format  ( IX,  inuPt^FUlCTlON  i I X 1 1 H»  , 1 X , «HFS  T , , bX  , 7H  AN  AL  hAt  3X» 

1 6i'ARF  A tST  I i|X  «SHFF(P0P*3X  t 1 H»  1 2X  t 0 Mt  ST  , * 6X  t 3FIPC  T f 3X  t I H*  i 

2 ?X,/)M|.r>  r , ♦6FFAIFAL  PRO»  iXf /HpRU  tST  » OX  » SMFRfFUF?  ) 
l»fUTF.(oinF’t900u) 

9000  FOKMAT(OX,bM(>OlNt.3X,1H+»?X*2HHAT5Xf3nOF((Hfl  rHUFn,3M  ♦ t 
1 bFtYlFLU»bX,bllFRK0R*2X,  1 !(♦  1 2X  f 3|HPR0  t Ox  1 3(  1 OHCPCI  TRUE))/) 

C 

C WRITE  UtiT  PRFDICIFOM  POINTS  FOR  FIRST  PaGF 
1PP=0 

DO  10  1=1,0 

lF(i’WlN0(l).t0,0)  on  TO  10 

II’P  = 1I'P+1  1 

Win  Tt  f olMP* ! SOO)  I , (CSUhR(U, IPP) , J=1 , 1 0)  ■ 

ISOO  FORMA!  (6X, 11, 3XtF  1 0 . 1 , Sf  1 0 , 2 , F 1 0 . U 3F 1 0 , 2) 

10  COFJTltlUl' 

IKMHOATt.EO.O)  00  TO  3o 
DO  ?0  I = 1,NP()ATF 
IPP»1PP+1 

WRITE  Coin  Rf 2500)  IPRD t2 , 1) , IPPD C 3, 1) , IPRD( 1 , 1 ) » 

1 • {CSUF!R(J,IPP),Jc|,10) 

2500  F0RHAT(2X,2(I2,  IH/)  t'12,F  1 0 . 1 , bF  1 0,2,  F 1 0 . 1 ,3F  i 0,2) 

20  CONTIHuF 
30  CONTIHUF 

CALL  PAOtR(IPP) 

C 

C WRITE  OUl  SUMMARY  INF  ORmATIOFT  ON  FIRST  PAGE 
CALI  PaGIF>(6) 

HWACs  hWAC^ARF ACF 
TMAC=  TWAC+ARFaCF 
TYC  = lYC  *YCF 
[I'lFOUfs  IPROorAPROCF 

hRITLToL'TP,  )bO0)  FI1,AC,(APRUTS(  dlNOX)  ,1  = 1,4) 

5500  F'ORmai  (//2X,  1‘.)iM1STURiCaL  ARF  A,3X»F  I0.2,3X,fiA6) 

wifjn  ruUTi’f'i'iOo)  iwac, (ApRuisUtiNox) , i = i,o 


USET13 
USE  T 1 3. 
USbTlS 
SliHRf  P 
SMmrkP 

sumrep 

SUMRFP 

suhrfR 

StlMFFLI’ 
Sl'MRLP 
SI'MRLR 
St'hPEP 
SlFMfFLP 
SUHHEP 
sumrep 
SUfiREP 
btliilFtP 
ol'MRLf’ 
suhrfp 
SlRiRt  P 
St'HREP 
Sl'flREP 
suMF<e  p 
Sl'tifFFP 
Sl'MRt  F» 
SliMRfcP 
SUM.9F.P 
SUti.RtP 
SI'FIIFFP 
SUMREP 
SMHREP 
SUMREP 
SIHF-'ER 
SUmFFF  P 
SUMREP 
SUMRt  P 
SUMRFP 
SUMRtP 

SUMRFP 
SUMREP 
SUMRFR 
SUHHf  P 
SUMRFP 
SUMREP 

SUmREP 
SUMREP 
SI'mif'ep 
SUMRFP 
SUMRFP 
SUMREP 
SUMFFF  P 

SUmRE  P 
SUflREP 
SUMREP 
Sl'MiFLP 
SUMRFP 

sumatp 

iUi||l»|,P 
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000119 

•OOOlPO 

O001?l 

OOOlPti 

0001>3 

ooru?9 

0001?S 

0001?6 

00ni?7 

ooo.i<'’y 

0001P9 

fioono 
000)31 
000132 
000133 
000130 
00013b 
000  rso 
000137 
0001 30 
000139 
OOOlOO 
OOOlOl 
000102 
000103 
OOOlOO 

ooo’l  Ob 
000106 
00010/ 
000106 
000109 
0001^0 
000131 
0001S2 
0001V.3 
000130 
000135 
000136 
000 137 
000  131) 
000159 
000160 
000161 
000162 
000163 
000164 
000)65 


4500  FI'HMAT(?X»9HT«UK  AKFA  ,9x  t F 1 0 . ?t  3x  1 3 A6) 

hHlTh(oUIP,b500>  rvCt  (YPMllTS'Uf  INDX)  f lalfS) 

5500  FOMHATtPXtlOHTHUfc  Y 1 1 LO , «X , F 1 0 . ? t 3X t 3 A 6) 

■ WHITt:((iUTP,6500)  TPROnC  . ( PPPDT  S (I  ♦ I NlOX  ) f I = 1 1 5) 

6500  Fl’RHAT(2X,l3Hri<U£  PttODUcIlUf'f  3X  ,F10 .2',  3X»bA6) 

C 

C SFcnHl)  PACt 

C Ilf  ADI  KS  . 

CALI  r.iFCTd  1) 

■ 5i;iTt(nurp,2ooo) 

hPITLfrtUTPf 3000)  CUNTRYtNT 
tiHITJ  (0"fP,7‘j00) 

7500  FOKHAI  (//30X,?2HARtA  r.OfjFIDENCt  LEYELSfP4Xf 
1 PO.'PMODUCTION  COHFTDFNCE  LEVELS  ) 
hRlTK(nli7Pf«b00) 

B5OO  FOUMAf  ( IXOOllPK'KUtCTlnN  ) 

'wiUTt(()li1p;9bO0)  . . 

9500  MIRHAI (0X,bllK01Nr»12X,2( lOHTRUE/ERKOHf2X,7HFST/rstt?X» 

1 HMlKllt/EST  f 3X»7H7KUE/hCt  1 1X1/) 

c ■ 

C WRITE  OUT  FREDlCnUN  PDINTS  FOR.  SECOND  PACE 
IPP-0  •• 

DO  40  1=1.4 

IF(H'<InW  I)  .fcO.O)  CO  TO  40 
1PP=1PP+J 

WRITtfOliTP.llOo)  Tt(CSUMH(JtlPp)iJsll.lfl) 

1100  F0hhAT(6X,I1,  13X»2(4HO,3.10X)) 

40  CQNTINUf 

i.Kiii'nA.Tt.Lo.o)  i;n  TO  bo 

DO  60  J=1.NPDATF 
1PP=1PP+1 

HiaTt(t)t)TP,2lOO)  IPHDf2,ntIPKO(3»n  .IPRDa.n  t 
1 (rpi'MU(.J,ipP),'j  = ntia) 

2100  FOR “AT (?X,2(12,1M/).I2, 1 OX » 2 ( OF  1 0 ,3 . 1 OX ) ) 

60  CONTIPUI'- 

50  continue 

CALI  PaOLIUIPP) 

CALL  PAOEPC3) 

WPUEfC)"TPt3100l 
3100  fOliMAT(//10X. 

1 53HTRur/ERRUR  AREA  AND  PRODUCIION  CONFIDENCE  LEVELS  ARE 
1 3bMCALl'Dl  ATtD  ONLY  FOR  .FINAL  ITtHATlON  ) 

C SET  NLINE  TO  tJECI  PaOF  AFTF'R  COUNTRY  SUMMARY  REPORT  BEFORE 

c print  INC  any  more  output 

Nl,IUt=  HXLINi  ♦ 1 
900  Ri:  rijRu 
END 


SUMRF.P 
SUFIREP 
SUHREP 
SUl-iRFP 
SUMPEP 
bOMHF.P 
SUMREP 
bt'IIHtP 
St'HREP 
SIlllRI.P 
bumu.p 
SlRlREP 
Sl-ijHLP 
Sl'HRbP 
Sl'F.RFP 
SlirlREP 
SUMPf-P 
bl'MHtP 
SMURF P 
bUMPLP 
bUMREP 
SMMI-'EP 
SMHPl P 
SUmRFP 
SMMRFP 

SMMREP 
bl'Hf’EP 
SMmHI P 
SUMPEP 
bllURf  P 
bUHRLP 

SUliPLP 

bUllRtP 

bUMF‘'F.P 

SUMREP 

SlINRFP 

SUMRFP 

bUl-lREP 

SUmRFP 

SUi-iULP 

5UMRCP 

SUMRF.P 

SUMREP 

bUHRfP 

SUMREP 
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0 FIT 

TSAVF'tl 

t'760'4?7,  6t?47'  f ! 

OOOQOl 

SUUROUTlNr  TSAVFUSFGf  iDPTflBAD) 

TSAVt 

00000<2 

c 

TSAVt 

■ 000003 

c 

THIS  SUPHOUTIHE  tIANOLES  THE  I/U  KOK  THfc  SCRATCH  RA  FILE  TACQ  FOR  CAHISAVr 

oooboo 

C • 

TSAVF 

■00000b 

. COHildU/TRAlNS/  C0UW7,lHfcG7il70Nt7»I6TRA7»ISU()7»IStG7» 

TRAINS 

000006 

1 ITHlM(4,?5) » 1 rTOTtTHMl if  4 ,?b) t TOtM 3 1 4 ,?b1  »T VV ( 3»4 t ?b) t ’ 

TRAINS 

000007 

1 TPTRlitf  n/WLU(4)»lPtST(4)  iTHIRRCO)  tTERT0T(3)  tTH(3)»TV(3)»TIU3) 

T R A J MS 

DOOOOH 

IRTFGfR  TI/IJI.U 

trains 

OOOOOV 

DIHFhSlON  ITRAinUdO) 

1RATNS' 

000010 

Four  VAl!  NCfc  ( I train,  OOIIfJ7) 

trains 

00001  1 

COHMUH/IHIIX/  IN''LX{  DflROlH]  (?00l)flPNT.2(?00t)flf'ENUiIPlN 

iNuX 

OOOOlrf 

c 

• FILE  OFFTNinoHS  Awi)  HECOHG  LENGTHS 

f TLF.S 

000013 

COHHOri  /Flits  / 

E TLCS 

000014 

1 SLt.lG  tLSEGiOfCRnpw  fLCROPW  ,SUfltlST  »ISUBH  »ACOUrS»LACG 

MLFS 

00001S 

'?  fCAMsf  ♦‘CCAHSf  ,CAI1tRR,LCAHtR*CASF  ,LCASH  » Yfc  SOUT  .LYL31) 

E TIE'S 

0000)6 

3 iSIGlX  r ,LSlCLX,YtSLRI<,LYF'5CKfSfcOrRU,LSLGTl?,CASDtS,LCASl> 

E ILFS 

00001  / 

4 »TNP  ,OIITP  »T'aCU  .LTACIJ  , C ASUSF  , LCASUS- 

E ILLS 

OOOOIO 

INIFIFk  ShGIG  ,SU11hS  r T AC(JIHS,CANSF  ,CANERR»rASF  ♦YFSOUT 

E ILFS 

OOOO  1 V 

1 tSIGI xTfYLSFRRtSFGTKlJiCASDlSiOUIP  ,TACU  »CASOSr 

^ iLFb 

OUOOi>0 

c 

EUES 

OOOOPl 

c 

AKGu'ltNT  list  FOR  FRROR  PkOCESS ING 

ARM  sT 

0000?^ 

COMMON  varc.lst/ 

AI'M.ST 

OOOOP3 

• COMMON  /ARGLST/  ■ 

ARM  ST 

0000?4 

1 N1  RrS  ,NFaTAI.  *NPFRRS,NARr,  tARCtlO) 

ARM  ST 

0000?b 

OTNFNSlON  IaUgMO) 

APGI  ST 

00O0,Jb 

fOUTVALENCL  ( TARGfARG  ) 

ARM.  ST 

0000?7 

c 

arglst 

0000?6 

c 

I SAVE 

00flo?9 

. c 

OPFN  FILI’ 

TSAVt 

000030 

lHAOaO 

ISAVt 

0 0 0 0 31 

iF’dOPT.NF.O)  GO  TO  lo 

TSAVt 

00003? 

L = bO 

TSAVt 

000033  ■ 

DIFlHf  Flit  16(50»  1020iU«TD'UM1 

♦ NtW 

000030 

RETURN 

TSaVE  **-1 

000035 

c 

TSAVt 

000036 

c 

CLOSE  FTlF 

TSAVE 

000037 

10  continuf 

TSAVE 

000030 

IF(IOPT.NF.-I)  go  to  ?o 

TSAVt 

0000.49 

CALL  RANACE  (TACQ»0,0»0t0r0f-n 

TSAVE 

000000  ■ 

KF rUKN 

.TSAVt 

oono'ii 

c 

TSAVt 

00004? 

c 

WHITE  TO  File,  StOUENTIALLY 

TSAVE 

000045 

20  CONTINUF 

ISAVt 

000044 

IF (iopt.nf,?)  go  to  ?S  . 

1SAVE 

00004b 

lPrMOsi(’EM0+ 1 

ISAVt 

000046 

irni'lNli.t  L.2000J  GU  TO  21 

1 SAVE 

000047 

NAKG=0 

TSAVE 

00004U 

CALI.  FRRHrS(4HCAMS,SHTSAVEf  4,1) 

TSAVt 

000049 

RnilKN  • • 

ISaVE 

bOOO‘30 

21  CONTINUE 

-TSavl ' 

noooM 

H'OiNT  ( n‘rNO,)3i!U:G 

ISaVC 

oooo''? 

lPnT?(iPtt.‘0)  = lPFN|i 

TSAVE 

OOOO'li 

CALI  HAl'ACF(TACO,THFMD»TTHAlM*1020TlNDtX,!,?) 

ISAVt 

OOOOS4 

Rf  ILIUM  _ . ' 

ISAVt 

nooobb 

. c 

’ ’ , 

T SAVf  ' 

000036 

c 

FiNiStIL'l)  HRIIFS  - SORT  lROXNTflPNT2 

ISAVt 

00003  7 

?b  (.(iflTlNid 

ISAVt 

(lOfio‘''ll  • 

IKIOI’l.m  .3)  GO  TO  30 

ISAV't 
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0000'59 
OOOO^'O 
000061. 
000062 
000065 
000066 
00006b 
000066 
000067 
000060 
000069 
OOOOVO 
000071 
000072 
000075 
000076 
0000 /'i 
000076 
00007/ 
000070 
000079 
01)0000 
OOOOOl 
000002 
oooooi 
000006 
00000b 
000006 


iPOI NT  ( I HrWHt)  =9999999 

CALL  SOPI AttT iPOINTt I » iPpNO* !pNT2) 

'CALL  RA6'ACF(TAC9f  0f0»0»0»0»-n 

• RFTliKN 
C 

C RE AO  FUdM  FILE 
C ■' 

C FINO  INIlpX  TO  IHOEXt  BINARY  SEARCH 
50  CONTn.'Ut 
1L=1 

lH=TPrn() 

52  CONTtWuF 

lL00h=(IH+It.)/2 

IMlPOlHT(It.OOK).FO.ISEr!>  CO  TO  55 

IP  (TPH|NTf  ILOOKI.GT.IStr.)  IH=ILOOK-l 

IP  (IPOINTUI  OOM  .LI.ISEG)  II=lLO'OKtl 

IF  UH.gE  .U‘)  GO  10  yd  ' ■ 

t’uAn=i 

Rt.IIIKN 

■ c 

C FOUND  CUnRtCf  INDEX 
55  CONTIHIJF  • , 

C ' ■ , 

C READ  TN  rF-COKO  IF  NOf  AlKFAOY  READ 
1P1H=1rNT^(ILOOK)  ■ 

CALI  PANACF(TACO*lPIN»ITRAIN»1020tlNDP:X*lin 

HnUKN 

END 


-TSAVt 
TSAVC 
TFAVE 
I Save 
I SAVE 
ISAVb 
TSAVt 
TSAVt 
ISAVE 
IPAVE 
TSAVP 
IRAVt 
lOAVE 
1 SAVE 
ISAVE 
tSAVF. 
ISAVt 
ISAVE 
TSAVp, 
TSAVt 
ISAVk 
ISAVt 
ISAVE 
TSAVE 
TSaVP. 
ISAVt 
ISAVt 
ISAVf 
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FOR, IS  TSUB 

SUbKUlJT  INR  TSUB  ‘ TSUB 

CUMPUTES  THE  OUAMTITY'T  {SECOND  TERM  OF  PPS  AREA  VARIANCE  EON.)TSUB 
T IS  GIVEN  BY  EO,  39  IN  CAS  PROBLEM  DESCRIPTION.  ' TSUB 

TSUB 

DATA  BLOCK  FOR' CAS  CUMULATIVE  FILE  CASCUM 

CAS  DATA  SETS  I4t  15,  16,  AND  IT  CASCUM 

CUMMON  /CASCUM/  CASCUM 

1  CASCUM(32),  BUFFR,(504)  CASCUM 

DIMENSION  ICASC(32),  DSET14(22),  DSET15(22),  DSETI6{22)  CASCUM 

I  ,DSET17(2B)  . CASCUM 

EOUIVALEMCE  ( ICASC, CASCUM  I CASCUM 

EOUI-VAtENCE  ( DSET14,DSETL5,DSET16  ,DSET17,CASCUM(  5 ) ) CASCUM 

1 , ( S(OAEKS,SOAERZ,SOAERR,SOAERC,CASCUM(24)  ) CASCUM 

2 , ( SOPeRS,SOPERZ,SOPERR,SOPERC,CASCUM( 25)  ) CASCUM 

3 , ( SQYERS,SOYERZ,SOYERR,SOYERC,CASCUM(26)  ) CASCUM 

C ' CASCUM 

C DATA  BLOCK  FOR  CAS  DISTRIBUTION  FILE  (DATA  SET  19)  CASDSB 

DIMENSION  CASDSB (303)  CASDSB 

EUUIVALENCE  ( CASDSB, BUFFR  ) CASDSB 

DIMENSION  ICAS0(303),  HWA2K(60),  WAKNEY(60),  PIK{60)  CASDSB 

EUUIVALENCE  ( I C A SD , H W A2K , C ASD S B ),  { WAKNEY , CASDSB ( 61 1 ) CASDSB 

1 , ( PIK ,CASDSB(12l  ) ) CASDSB 

C ’ • CASDSB 

C CAS  DATA  SETS  4,  5,  AND  6 {AT  STRATA  LEVEL)  DSET.4 

CUMMUN  /DSET4  / DSET4 

1 STRATA, TWASl  ,HWAS1  ,EWAS1  ,XM1JS  ,XCT1S  ,AMVS1  JULY76 

2 ,TWAS2  ,HWAS2  ,EWAS2  ,XM2JS  ,XCT2S  ,ANVS2  ,T  JULY76 

3 ,TWAS3,HWAS3,XCT3S 

4 ,XYS  ,XESTYS , EVYRS  , P2 I OPK , V IV 2S  ,VARS  , ANVARS  JULY76 

5 , F I LL4 (57) 

INTEGER  STRATA  v"'i  Y76 

DIMENSION  DSET4(24),  OSET5(7),  DSET6(3>  • JULY76 

EUUIVALENCE  ( DSET4, STRATA  ),  ( DSET5,TWAS2  ),  { DSET6,TWAS3  ) DSET4 

C 0SET4 

C TSUB 

CON  = XM2JS/HWAS2  ' . TSUB 

NS2  = XCT2S  ■ TSUB 

C COMPUTE  ALL  PI(K),  THE  SUM  OF  PI{K)=:^=:'2  OVER  ALL  SUBSTRATA,  TSUB 

C AND  THE  SUM  OF  PI(K)-'«3  OVER  ALL  SUBSTRATA.  TSUB 

SUM 2=  0.0  TSUB 
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SUM3=  0.0  TSUB 

DU  110  K=1tMS2  . TSUB 

P1K(I<)=  C0M«HWA2K  (K  ) ■ ' TSUB 

SUM2=  SUM2  + P IK  (K  )':«=i=2  TSUB 

'SUM  3=  SUM3'+  PIK(K)^.‘*3  TSUB 

110  CONTINUE  ■ TSUB 

TSUB 

COMPUTE  CONSTANTS  WHICH  DEPEND  ONLY  UPON  M2JS  AND  HWAS2  TSUB 

INDEPENDENT  OF  SUBSJRATA  TSUB 

CUN1=  ( XM2JS-1.0 ) /XM2JS  ■ TSUB 

C0N2=  C0N1/XM2JS  TSUB 

CUN3  = 2.0'^CON2/XM2JS  TSUB* 

C0N3S=  CUN2--SUM2/XM2  JS  TSUB 

CUN4S=  3.0’;=C0M3S/XM2JS  TSUB 

CUN4S3=  CON3-SUM3/XM2 JS  TSUB 

CUN5S2=  C0M4S*SUM2/XM2 JS  TSUB 

C TSUB 

NS2M1=  NS2  - 1 TSUB 

DU  210  K=1 tNS2Ml  TSUB 

WAKPIK=  WAKNEYIK )/PIK(K ) TSUB 

PIK2=  P1K(K)*':=2  TSUB 

P1K3=  PIK2*PIK(K)  TSUB 

C . ‘i  SUB 

KP1=  K + 1 TSUB 

DO  210  KP=KP1,NS2  TSUB 

PIKPKP=  PIK(K  )*PIK(KP  ) TSUB 

TERM2=  PIK2’:=P  IK(KP  ) + P I K ( K ) *P  I K ( KP  ) ';‘-:‘2  TSUB 

C . ' TSUB 

P1KPP=  C0N1>I‘P  IKPKP  ■+  C0N2*TERM2  - C0N3S>I-P  IKP  KP  1 SUB 

1 + C0N3*(  PIK3*PIK<KP)  + P I K { K ) «<P  I K ( KP  ) >:<«3  + P 1 K2>!=P  IK  ( K P ) ) TSUB 

2 - C()N4S'^TERM2  + C0N5S2=1=P  IKPKP  - C0N4S3-P I KPKP  TSUB 

C TSDR 

T-  T + ( PIKPKP  ~ PIKPP  )>l‘  ( WAKPIK  - WAKNEY(KP)/  PIK(KP)  TSUB 

210  CONTINUE  ' ' TSUB 

C TSUB 

yOO  RETURN  TSUB 

END  TSUB 
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0 fUT  WRAPUPflf760'l3Of  5OI07  ♦ I 


00000,1 . 

SlJbROlJTTNF  WRAPU2 

WRAf'UP 

000002 

c 

WRlIpS  HEADHK  KfCOROS  ON  C.ATi  CUMULATIVt  FILF  *N0  CAS  DISTR.  FILFkRAPUR 

000003 

c 

Cl  OJ-tS  RANOOH  ACCFSS  FlUS  (GASCON  AMD  CAS0I5) 

Wl’APUP 

000600 

c 

PRUTS  STATOS  |N^ORMATION  AT  FNl)  OF  RUN, 

wRaPuP 

000005- 

C ■ 

hRAPuP 

000006 

c 

ARCuHCNT  t.IST  FOR  FHRUR  PROCESSING 

arglst 

000007 

COMNOI,  /ARf'-LST/ 

APr.LST 

00000!! 

t MI.I-'rS.  ,HFaTaI  tNpERRS,NARG  lARGUO) 

Af’uLST 

ooooov 

DIMr/ISlOU-  URGdO) 

ARU.ST 

0000 1 0 

' 

.t'JUrVALFNCt  ( lARt»APG  ) 

ARbt  ST 

0000  1 1 

■ c ' " 

«l?U  ST 

0000  1 2 

c 

■ CAS  rOllTROi.  CARD  INPIJI  DATA  AND  CONSTANTS 

cascm 

00001  3 

COMMON  /CA5CN  / 

C/SCM 

000010 

1 AKFACFtYCF  tPRDCF  ,APRUT5(a*2)  tPPKlJTS  (5t?)  ♦ YP«llTS(3ia) 

CASCM 

00001  5 

?.  t ARf  ftPSf  S'PhAX  fNHlSTYWlH  fTUPT  * Al'NI T S t DIS  TFF  tHRlNOT^) 

CASCM 

00001  6 

3 rKlRrOKf-'n  ♦APRfcP  .IPHDCTtlR)  t NPOA  I F > PRI'AT  t ( 1 '0 

LAbCH 

00001  / 

IWTFCFR  HMf  TUPTf  AUNlTS»DlSTFF»liwlMnWPRinRrAPRFP»PR(JAlE 

CASCM 

00001  li- 

c 

CA;>CM 

no  00 1 9 

c 

DATA  bUOCK  FOR  CAS  CllMUlATIVF  FUt 

CASCUM 

000020 

c 

CA'-.  DATA  SFTS  l«t  lb»  I61  A(,D  1/ 

LASCIJM 

OOnuPl 

COH'lllN  /CASCllM/ 

CASCUM 

000022 

1 CAScl'Al(32)  f HUFFRC504) 

CASCUM 

000023 

OlMENSinM  UASC(32)»  DptTJ4(22),  DSLT 1 5 ( 22)’,  DSbT16(22) 

CAsCUM 

000020 

1 iPSFt1/(2«) 

CASCUM 

00002b 

tout  V All NCL  ( rCASCfCASCUH  3 

CAsruM 

00O026 

enui  v/>l  FfiCt.  C n6(;  r 10,DsCT  IbjDSTT  16»DSCT  l7irASCDM(bT  ) 

CASCU‘1 

00002/ 

1 « C sOAf  RS,S(JALR/*SnArRR>S()AfcRC»CAbCUM(241  ) 

LAsrijM 

000020 

2 t ( sOPf'HS,S(JPI  R7.SnPFRRfSoPtRCfCASr:UN(2bT  ) 

CASCUM 

000029 

3 t ( sDYFRS,SuYI  il2.S()VH<RtSi}YtRCfCASCUH(2t)l  ) 

CASCUM 

000030 

c 

CASCUM 

000031 

c 

data  IJLOCK  for  CAb  OtSTUKJUT  TUN  FILL  (DATA  SM  19) 

CASDSO 

000032 

UTHFNSJON  . f;ASur,!J(3n3T 

CAsnsH 

0000  Ki  ‘ 

tOUTVAl  FNCt  ( CASuSb.Hl'FFR  ) 

CASDSl! 

000030 

DTi'.fcNSlON  1CASD(303)i  HWA2h(60)f  WAKNFY(60)f  PlK((,0) 

casdsm 

00003b  ' 

E'JlJlVALf- WCF  ( lCASD,Hri'A2K,CAfiD;ilj  )»  ( W AKNF  Y f CASDSil  ( 6 1 ) ) 

CASDSP 

000036 

1 . ( PIK,CASDSH(121)  ) 1 - 

CASDSrt 

00003/ 

c 

CASDSD 

000030 

c 

flags  and  COUNTfcPS  FnR  CAb  SIMULATOR 

L ASF  LG 

000039 

COMtlUN  /CASFtG/ 

CASFlG 

000000 

t H iPRFLG  rNUW  tWlNUOHtlPO  tIPP  »PPDATE  vNRFGS 

CASFl  C, 

OOOOOl 

■ 

2 fM/ToT  ,hSTRATrMYrSSK,NSSUSKtNcAHSh.NPYFS  iMRSSU  tNRCAMS 

CASCLC. 

000002 

3 tl-.finc  ttNDRLGrtNl)3nN,lRSTH  * IRZUNLi  IRRFG 

CASFLG 

000043 

4 flUSl  *LDS4  »LUS/  ,LDSO  it  DS9  ilDbtO  ilDSll  »LDSl2  »LDS15 

CASFlO 

000004 

S •ilUSjlt  ,LD5lb  iLDSU  ,LDbl7  .l.flCUUr4,LRKEG  »l  H70Nt *LRSTR 

CASf  LO 

oooonb 

IMFGIR  PPFlO  1 WlNUOh  i I'PUAIF 

CASFLG 

000046 

c 

CASFLG 

000047 

' c 

CONTPOl  PaRAMLTERS  FOR  LEH  PROGRAM 

LNTRI 

00  00  /|tJ 

COMMON  /(NTRI.  / 

CNIRL 

0 0 0 0 n 9 

1 PKlhlC iNSlART.SLFOf 7) 

cnirl 

0000'>0 

INTFGFH  PRKiTf 

CNIRL 

OOOysi 

OOUilLF  f'RtCISIOM  3EL0 

CNIRL 

000yb2 

c 

• 

CNIRL 

0000S3 

c 

FUt  UFI-lNinORS  AND  RECORD  LENGTHS 

FTLFS 

flOOOb'l 

CONHUN  /FILLS  / 

FILF3 

OOOObb 

r SLGJD  ,L5LG1D,CR0Pw  t L CROP!.' i SUHMST  iLSUni!  lACOUTSiLACO 

F II  FS 

oonobb 

2 .fCAHsF  ,lCAMSF'iCAtH.RR,LCAMLRiCASF  iLCASF  i YESOU  TiLYtSO 

M i F S 

0 6 00',  / 

T ;r,  IC|.  XI  ,LSlf;.(.XfYLRLPR*LYkSLRiRF.CIRUtL?lOtPtrASUIS*LCAr)D 

1 HFS 

oono'.ii 

4 lUJI'  imllP  iTACU  iLlACu  tCASDSF  .LCaSUS 

n i F 3 
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OOOOS‘> 
000060 
000061 
000062 
00006i 
000060 
000065 
000066 
000067 
000060 
0OO069 
OOO070 
000071 
000072 
000075 
000070 
00007S 
000076 
00007  / 
000070 
000079 
0000*^0 
0 0 0 0 (i  1 
0000(^2 
OOOOHi 

oooooo 
000065 
000066 
00006  1 
flOflOC.O 
000069 
000090 
0O0091 
000092 
000095 
000090 

0000‘>i> 

000096 
000097 
000095 
000099 
OOOlOO 
OOOlOl 
000102 
000105 
OOOlOO 
000105 
OO'O  1 06 
000107 

oooinrt 
000  1 nv 
000110 
000111 
000112 
000  1 1 5 
000  1 1 0 
000  1 15 
000116 
000  1 1 7 
0 0 II  M 0 


I INTEGFR  SERJO  fCffOPW  fSUIlhSI tACUUIStCAMSF  tCAHERRfCASF  tYFSOUT 
;t  »SHitxTtYtS£RH*8b6TRUtCASl)I3t6urP  fTACQ  iCA3t>5F 
J 

! TMDEX  REEORU  FOR  CAS  CUMULATIVF  FILE  (CASE) 

I COMMON  /IXCASF/ 


1 


TXCaSK  1)  iLIXCaS 


OATa  UlOCK  FOR  CAS  DlSTHlbUlION  FILE 
COMMON  71XOISF/ 

1 ixniSF(  jit  Lixnis 

HOTfc...  S07)' ONLY  ALLOWS  UP  TO  R PREDICTION  POINTS  INCLUDING 
HIOkTNOOWS  ( 506  = 1 L 1 ♦ B’»65t  INDEX  + HEADER  ♦ 5 PRED,  PIS.) 


LEM 
COHMUM 


CONTROL 

/LEMCM 


input  data 


1 

2 
5 

4 

5 tRbFEO/tlrsFSTf iLSECUtlCSEYStlCSLCUf ICStcn 
D I HI- NS  1 ON  RbEED(7) 

OOUHLf  PRFCISION  RSEFD  tRSEEDl  i RSEEU?* RSEEDitRSEFDil  t RSEE05 
1 fPST  C D6tK!-Ef'u7 
EOUIVALF^ICE  ( RSEMI.pSFEIU  ) 

1NTF6FR  RST ART»STARn7tSTARTX»tHDR  lENOZ 

statistical  information  for  LEH 

EOMMOH  /STATS  / 

1 ' tier  ♦h:>LGTM,NLAM5H,NYESH  tNHEC(7)  tNCASCRtNCASDR 

EOUlVALbMfE  ( NTtlTER  ) 


110 


120 


WRITF  header  record  on  CAS  CUMULATIVE  FILE 
CASCUM<1)=  6HCASCUM 
ICASCf2l-=  TCASF. 

CASf.UH(5)=  ruNTRY 
ICASL(6)=  NT 
"ICASCCS)  = nrfos 
ICASCf6)  = tI2TOT 
ICA.<jC(7)  = NSTRAT 

stori  HitH-iNDOw  Numbers  in  words  10-15  of  header  record 

NHW=  0 

DO  no  i = if« 

irASC(l+9)=  0 

IF  ( (iklNDi:!)  .to.  0 ) GO  TO  ItO 
NDW=  NhM  + 1 
ICASC(NltW49)c  1 

continue 

shirt  how  And  Npoate  in  words  b and  9 of  header  record 
icasccb)=  now 
irAoc(<>)=  npdatf 

STDrF  7ULU  prediction  DATES  IN  WORDS  10-27  OF  HEADER  RECORD 
DO  120  Jsltl'l 

icAscTnnm  proateu) 

CONTIMiF 


DO 


FILL  IM  IHST  of 
no  ia2a»i.CAr>F 


headfr  record  with  /fhcis 


MLrs 

files 

FILES 

IXCASF 

IXCASF 

1XC.ASF 

IXlasf 

IXOISF 

IXDTiF 

IXDISf 

IXUISF 

ixnisF 

iXUTSF 

LF  MCH 

L!  mCM 

LT  MCM 

LFKCH 

LFNCM 

LFtiCM 

LF  HCM 

LFMCM 

I ( MCM 

Lf  urn 

LtnCM 

LFMCM 

LFMCM 

stats 

stats 

ST  ATS 

STATS 

S T A TS 

hPAPUP 

WRAPUP 

hPAI'UP 

RRAPUP 

NIIAPUP 

Kl'APUP 

WPAPUP 

ItRAPuP 

WtfAPuP 

M'APUP 

hRAPuP 

WRAPuP 

WRA'’UP 

WPAPUP 

WF'APuP 

WRAPUP 

WRAf'UP 

WRAf’llP 

hPAPUF’ 

WI’APUP 

WPAPUP 

WRaI’UP 

WRAPUP 

WRAPUP 

WRAPUP 

WKaPUP 

wRAiniP 

WKAPUP 

WR  Al'IlP 
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V. 


ooon*^ 

OOOIPO 

00.0  1?1 

000  1?'^; 

0001?3 

0,00  1?0. 

000  i?y. 

000)?6 

0001?/ 

0001?fS 

00017V 

000130 

000  H 1 

00013? 

000133 

000130 

ooni3‘j 

000130 

000137 

000130. 

000139 

000  lOO 

OOO 10 1 

00010? 

000103 

000100 

000105 

oooloo 

0 0 0 1 0/ 

0 0 0 1 0 H 
000 10 V 
000150 
000151 
•ooois? 
00015.S 
ooo ISO 
oooisb 

000150 
00015/ 
0 0 OlMl 
flOOl'iV 
000 100 
tlOfl  IM 
00016? 
000163 
000160 
000165 
000166 
000167 
000160 


ICASC(H=  0 
130  CONTlHUl 

. c ■ 

CALI  RANACF  ( CASFf  !»CARCim*LCA3FtlXCA8F'rUXCAS*?), 

C CUnsl  FAS  CUMUi  ATlVt  FILE 

' CALL  Ra^ACF  (CASF»0»O»O.OtOi-l) 

C 

IF  t mSTFF  .FO.  0 ) GO  TO  BOO 
C 

C white  HEADBK  HFCOKO  onto  CA3  DISTHIbllTION  FILE.- 

C note  that,  CaSCUM  ARKAY  is  GtTNG  USED  INSTEAD  OF  THE  CA8DTS 

c array. 

CA&CU^'(^=  6HCASUIS 
1C'ASC(7)=  0 • • 

CALL  RaF'ACF  (CASDIS»t»CA8f.UHrLCAS0tIXDISF«LlXPlS*?) 

C r.LnsF  FAS  niSlRIBUT  ION  FILE  ■ 

■CALL.  J-'aNAcE  (CASDISfOf  0f0f0»0*-l) 

c . . ■ . . . , 

c PHInT  PHOllRAM  SlATuS  INFORMATION 

Boo  NRLF(3)=  MRSSH  - NSSlLSK  * 1 
’N1  = NHCAMS  - NCAhSK  +1 

N?  = NHYtS  - NYLRSK  + I 

NCASCR  = rtUFr.3  ♦ lUTOT  + N5TKAT  t i 
NCASOR  =-(NRtC.6  + N/lTnl  + 5)*IPP 

■ C 

CALI  FjFCT  (331 

HHITt  (OUTP.l)  NSIART»NT»NREC»NJ tN?*NSEGTK*NCAMSHtNYESR»NCASCH 
1 tNCAsOHiSFFOiNPFRRS 
G 

1 format  </30Xt5lHP  ROGRAM  STATUS  INFORMATI 
IN  //5X,I5f5XT?YHlNITlAL  monte  CARLO  ITtHATlON 
. ? /5X,  t5.5X,?')H>  ThAL  'monte  CARLO  ITl  RATION 

3 //5X,I5,5X,53NRFC0RnS  READ  FROM  SEGMEMl  ID  FILE 

A'  /5X-,  J5.bX.34HRFCnRnS  READ  FROM  CROP  HINODti  F ILF 

5 /bX,  J5.5X,fl3l‘HI  C0R>S  READ  FROM  SLIHSTRATA  HISTORICAL  FILE 

6 /bX,  I5.bX,33liRELnRr>S  RFAI)  FRDH  CAmP  FRRuI?  FRE 

7 /bX,  IbtbXf  lO!  RFCOROS  RrAO  FHDh  YES  ERROR  Mf)|;FL  FILE 

8 /bX,  IbtbX,«?ORFLnRD&  READ  FROM  blON'ATORt  EXIEnSION  FILE  , - 

9 /5X,  Ib.bX.  30HRKcnRDS  RFAD  FROM  UAlA  AC  00 1 S T 1 1 0.N  FILE 

A //bX,  tb.bX,  lat  RlLORnS  READ  FROM  CAMS  OUlPliT  F ILF 

H /bX,Ib'.bX,5(>L‘RELnRl)S  RfAl)  FROM  YFS  ERROR  MOuE  L FILE 
C /bX.IbfSX,  IVPRHtORDS  WHITIFN  ONTO  S LOME  NT  TRUTH  ULt 

" ' D /(bX.IbtbXf  37HRFCORDS  mRITIFN  ONTO  CAMS  OUIPUT  Flt.L 

E /bX,I5tbX,36‘-!RFL0RDS  HRITUN  UNTO  YES  OUTPUI  flLF 

F /bXf Ib«bX,O0HRFtORoS  HU1I1FN  ONTO  CAS  CUMUlATiVt  FILE 

G . <'bX,Ib.bX,«<;HRFCnHriS  WRITIFN  ONIO  CAS  UlSlPIPLiTION  FILE 
H'  //6X,??HRAMH1M  NUMIlfR  ,SEEOS  = D 1 V . 1 ?/6  ( 3o  X f D I R , 1 ?/ J 
I//5X.  JbtbXt'Ir'H  • LRHORS.  OETtCII'.O  DURING  FXFLUIION) 

900  RFTIJRU 
FND 


WRAPUP 

WRAPUP 

WPAPU'P 

hT’APUP 

hPAPuP 

HRaPUP 

hKAPUP 

hPAPUP 

HPAf'UP 

HPAPllP 

hRapop 

hRAPtiP 
hP  AI’OP 
HRAPliP 

wpapup 

NIJ  A'’ljP 

hRAPUP 
WRAP OP 

hpapup 

WRAPUP 

oPAl’IjP 

wRaPiiP 

wrap OP 
ViPaPIIP 

hpapoP 

HPAPllP 
WP APOP 
rlRAPOP 
Wl’APlJP 
0 WRAPljP 
WRAPUP 
■rtRAPUP 
KPAPOP 
HPAPOP 
HRAPUP 
HPAPUP 
WPAPUP 
nRAPuP 
wPapop 
WRAI'UP 
hPtPOP 
HPAPOP 
WPaPoP 
hPAPOP 
WRAPUP 
WPAPOP 
HPAPUP 


♦ HF.W 

*«~1 
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(»  CLT  YtSft  f 760^28*  74^70  t 1 


OOOOOl 

SHOROUtINF  yes 

YFS 

000002 

c 

THIS  sOi'.hOUTINE  CALfUl.ATfeS'THE  ESTIMATED  YIELD  2K0M  THE  TRUE  YIELD 

YFS 

000003 

c 

YES 

oonono 

c 

AND  A IUNDDM  NHmHER  FRDH  A BfTA  DIS [RIHUTION t A BIAS  AND  A 

Y(  S 

OOOUOS 

c 

SlAiMOARD  orviATION.  IT  WELDS  INEUT  HUE  YEPLRK  ASU  HRUDUCES 

Yf  S 

000006 

c 

OUTPUT  HLE  YESuUI*  ALSO  AN  OPTIONAL  REPOKT, 

YES 

000007 

c 

YFS 

OOOOOtt 

c 

UN  CONTROL  CARO  INPUT  DATA 

Lf  HCM 

000009 

COMMON  /I  LMcM  / 

LFHCM 

0 0 (1  0 1 0 

1 'TITLf(lO)  fICASE  ,ClJNTRYtNlRI ALiRSTAKTfiPPINI ,STARTR*STAKTZ 

LFhCH 

00001  1 

" ?.  tFNDR  tLN|>Z  tt:»TU  ,ICAHS  rlYlb  fUCO  » 1 LI  ASSt  ISF,  YT  *IbCC 

Lf  HTM 

0000)2 

' 

3 »ICAs2  tlCAS3  tlPRCAH.lPKYLSf lPPCAS»ICSESG»ICSLCr(,ICbESHf JLSfcCL 

lemch 

00001 3 

4 » KSE.YKf  ICSESEf  ICSfcACtKSEFDl  *RbEL()2tKSLEU3fli6FED4.KSLED5»RSEED6 

LFHFM 

OOOOl  0 

5 tBSltn7.irSFSr, ICSLCO.ICSEYStlCSECUtlCbFCn 

LFMCH 

oooyi  b 

DIHENSIDN  VbEEiH?) 

LFnCM 

000016 

onUdLF  PRrCiSTON  RSLFD  »R3Etl>l ♦KSEED2tPSEED3tKSLED4f RSELDb 

1 FHCM 

00001  / 

. 

t rRSEED6.RSLED7 

1 1 ItCM 

0 0 0 0 1 0 

LOUIVAlKNCL  ( RSFEDtPSFLDl  ) 

LI  hCM 

000019 

INirClR  PSTARTtSTARlPjSlARl/fENDR  »FN07 

Lt  HC.H 

OOOOPO 

c 

1 F urtt 

000021 

c 

rUMTROl  paRamlters  For  leh  pruchah 

LNIRL 

000022 

COMMON  -/CNTnL  / • 

CN|»L 

000023 

t f>«TNTF.NSlARTrStF.Dt/> 

cnirl 

000020 

INTEt.FR  PHInTE 

f-NTRL 

000025 

OOUnLh  PKrCISlUN  seed 

LNfRL 

000026 

c 

LNtRl. 

00002'/ 

c 

Ailf.Ut'l  NT  LIST  FOR  ERROR' PROCESSING 

AP(.l  sT 

000028 

COMMON  /ARCLSI/ 

APrLST 

000029 

\ NLRRS  ,NFATALtNPF.RRS,NARC  ,ARr,(10l 

APLl  ST 

000030 

DIMENSION  IaRGTIO) 

ARGt  ST 

000031 

E.0U1VALFNCL  ( lARGiARG  ) 

APGl ST 

000032 

c 

* 

ARGl  ST 

O')  0 033 

c 

FIEl  DEFINITTOWS  and  RECORD  LENGTHS 

FILES 

000034 

COMMON  /Kit  E-S  / 

F U ('  S 

00003b 

1 SLt.lD  fLStClDfCKOPw  , LCROPW , SUl'MS  t » LSUHH  tACOUlS,LACO 

FIl  FS 

000036 

2 tCAHsF  ,LCAMSF.CAHEHR,LCAHLR»r.4r.(-  tLCASF  »YE.S0U1  »LVLSO  , 

F ILFS 

000037 

3 tSlGEXT.USIGtXTYESER«»LYESLRtSLGTHU»LSbGinfrASDlS«LCASO 

HI  FS 

000038 

4 t).NP  tUllTP  »TACO  ,LTACU  t C ASDSF  tLC  ASDS 

F ILFS 

000039 

1NIL6FR  SCI.ID  iCROPW  fSUmtSTtACtJUIS.rAt'sF  *CAMERHjCASE  fYFSOUT 

ftlfs 

OOOOOO 

1 fSlOE  xTfYLSfPRjSF.GTRU.cASDIStUUIP  >TACQ  tCASDSF 

HLFS 

OOOO't  1 

■ c 

hlfs 

0000'I2 

c 

STATISTICAL  INFOf'^'i'rON  FUR  I.LMi 

STATS 

000003 

COiMMON  /STATS  / 

STATS 

000004 

1 IlFlf  ,USEGTR,NCAriSH,NYtSR  t NRCC ( / ).* NC ASCR» KCAPUR 

STATS 

OOOO'ib 

EOUIVAlFNCL  ( NlflTLR  ) 

STATS 

000006 

c 

STATS 

00004/ 

c 

PAGE  EJECT  control  PARAMETERS  FOR  LE« 

PAGE'LM 

OOOO'iO 

COMMON  /PAGE  CM/ 

pagfch 

000009 

I NPA(jF  ,N1  iNt  tMXL  1NF.,WSITL  fSUHITL(IO) 

paglcm 

OOOO'iO 

c 

I'Al.ECM 

OOflObl 

COHIiON/YtSIN/  CUUNi  iHLGt  I/()nE  1 1 STH  A T . Y TRUL  . IZULU ( 6)  tOlAStS)  » 

Vt  S 

OODOS2 

t Sl)(6l 

Yl  S 

000053 

COMHUN/YtSOT/  ClD.lRtGlOiI/DNl0.lSlHIDfYSTR.lZP«DD(6),YSCI(6). 

YFS 

000054 

t VSYCltO) 

YFS 

OOOOb'i 

DIMENMON  YMAMET2)  iIOl)T(i) 

YES 

0OO056 

DATA  IE  ILL  /O/ 

Yl  S 

0000'.  7 

OAlA  YNADI  ( 1 )/3HYF‘b/tYNAM!'l?}/lH  / 

Yl  S 

00  0 0'i8 

DAI  A //•///'tll/ZZ?/ 

YFS 
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000059  ' 

DATA  lN(->  /O/ 

YFS 

000060' 

..INtW  = 0 

0000#>l. 

KKWIun  YtStRH’ 

YFS 

OOOOAri 

RF'WTIin'  YhSQin  . 

YFS 

00 00 OS 

nyisk=o- 

YF  S 

oooooo 

MOLC(‘i)Cl 

YFS 

000005 

■ Ft  A !<(;=<) 

YF  5 

oooooo 

NSTTLsO 

YFS 

000007 

C 

YFS 

000060 

c SKIP  MtADFK 

YFS 

000069 

KrADlYhStfiR) 

YES 

00.0070 

C . ' , 

YFS 

000071 

■“  C*'  SK1P  TO  nf'OINNlUG  20HF. 

YFS 

nooo7a  1 

10  kFAniYpShPR)  C0lJN»lRtr,»TZONEf  ISTRATtYTRUfct 

YFS 

00007S 

1 (Ul)|  U(I).UlAS(I)t5DCi}fl  = lf6) 

Yl  S 

000070 

’ IFCrOI/fl.Nt.ZZZZ)  GO  lo  ?0  ■ ■ > 

YFS 

000075  r. 

• c ■ - . ■ 

YFS 

000076 

C IF  CAMIKIT  FIND  START  70Nt»  RtPURT  ERROR 

YFS 

00007/ 

CALI.  FRPMFS(3HYF6fSHYFS*ltl) 

YFS 

000078 

Rt  TURK 

YF  S 

0000/9 

20  COMTINut 

Yl  S 

OOOOKO 

C 

rrs  - 

00  DO  81 

• C IK  FOUND  START  RECORD  - START  PROCESSING  RECORDS 

YFS 

00008 J 

IKCIRI  G^Ut.SlARTR. DR. 170NE.Nl. start/). AND. S1ARTR.NF..0)  GO  TU 

10  YFS 

00D08S  ■ 

1TLMP=| YLSO-i 

YF  S 

000080 

C WRITE  IIFaOEH  TO  OUTPUT  Fill 

YES 

00D08S 

«R1TL(VE60UT)YNAME{1) ,YHAMt(2)tICA5Ff (IFILLiI=l»ntMP) 

YE  S 

000086 

22  CONTI f'l-> 

YES 

OOD 087 

Lru  = C8|)M 

YES 

000088 

lin.C.IO=Tl<FO 

YFS 

0000,89 

■ ■ I7UNll'=IZ0NF 

YFS 

OOOU90 

l.STRir.=  ISTKAT 

YFS 

000091 

ysir^ytruf 

YFS  • 

00009^ 

c 

■■  YFS 

noooos  • 

C WRITE  HFaOIHG  on  output  rfport  if  option  on 

YES 

000090 

IFO’RTnTF  .EP.O)  GO  TO  26 

YES 

00009'j  . 

|MEN=  Itfl  w+ 1 ■ , 

YFS 

000096 

IF (INF H, OF, 6)  1NEK=1 

YES 

000097 

IF (TNI w.GT.l)  CO  TO  27  . 

YFS 

000098 

CALL  1 Jf CTC?) 

YFS 

000099 

WRITLFOOIP. lOPO) 

YES 

oootoo  ■ 

wRITL(oOIPi1000)ITER 

YFS 

oooiol 

1.000  FORMAT(32Xf ObHrFS  YIELD  ESTIMATE  DATA  REPORT  -ITERATION  NO. 

» YFS 

OOD 1 oa 

t'  15) 

YFS 

oooios 

27  CONTIMuF 

YF  S 

000)06 

C'ALl  PaGLR(6) 

YFS 

000105 

WRITE  f i)lJTP*lO?0) 

YFS 

000106 

wRinrooiPtioPo) 

YES 

000107  

' WRlTE(oOlPflOl.O)COUN*rRcGflZONE«ISTRAT 

YFS  ' 

000 108 

1610  FORtUTl  2Xi8mC01INTrY  ,A6f8H  RFGlON  ZONE  fISf9K  STRATUM 

»I3)YFS 

000109  . 

WRIT),  fnini’i  lOPO)  • 

US 

0 0 D 1 1 0 

1020  FORUAT (IX) 

rl  S' 

0001)1 

WRIT!  fnUll'.lOSO) 

Yl  S 

0001)2 

lose  FnUNAT(6Xr lOhHREDKT.DATE  .IPHThUE  YIELD  t2X r 1 SHEST  IH.Y  lELD 

t YFS 

OOOlli 

1 1X1  lOlU’ERCtHT  flSHsTAHDARD  DEV,  ) 

YFS 

0001 16 

wRlTMotMPf  tO'lO) 

Yf  S 

0001  lb 

1060  FOR«A7 (6X18HM0/DY/YH  ,6X  t 1 6HOU I N . /HEf I AK  ♦ 1 6HOU IN ./HEC 1 AH 

* YFS 

000116 

1 IOHFrRUR  tl6h9Ul)^./HECTAR  ) 

YFS 

000  1 1 / 

pH  CONTI )‘i)l  ■ . • 

Yl  S 

0001  1 8 

q INlTIALl/f  OUTpDI  HFlORO  TU  ZFHOS 

Yl  S 

¥NtH 
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000119 
OOOlPO 
000131 
■0001?2 
000133 
000139 
00013S 
00  013<> 
000137 
000130 
000139 

ooono 

000151 

000132 

000133 

000134 

0u0l3b 
000  1 3o 
000117 
0 0(1 138 
000  139 

0 0 n 1 « 0 
0 0 n 1 « 1 
000  1 02 
000  103 
0 (t  0 1 0 0 

oooioi) 
0 0 0 10  6 
0 0 010  7 
0 0 0 1 0 u 
000  109 
OOOISO 
cool'll 
000  I*-, 2 
OOOlSi 
OOO  1*50 
000  iss 
000  1^6 
000  1S7 
000 IS8 
000  15,9 
000160 
000161 
000162 
000163 

000164 
OOO  Hi's 
000)66 
000167 
000  168 
000169 
000170 
000171 

000  1 72 
000173 
000179 

0001  /‘> 
0 0 0 1 7 6 
000177 
0 0 0 i 7 8 


' . ■ 00  35  J=1.6  YFS 

I-7HI’DO(J)=0  7FS 

■ YSCt(J)=0.  YFS 

VSVCHj)=0,  YIS 

3b  CONTINUF  YfS 

C • YfS 

c ' OinOUT  OeCORO  for  each  prediction  POINTt  CUHPUTING  ESTIM.  YIELD  YlS 

DO  /lO  J=l»6  YFS 

IF(I2|ii.lJ(.I)  .EO-.O)  GO  TO  50  YFS 

I7PRUD(J)  = I7UUICJ3  ■'  YFS 

VSYCl  (j)=SOtj)  YF'S 

‘ YF)tHJ)  = YTI<iJE  YF3 

C"'  ■ ' YFS 

C CHECK  for  no  F'kROB  F3TIM,  OPTION  YFS 

IF(iYrs.E0,3)  GO  TO  30  YFS 

CAU.  flETAOFSEF'iiCi)  f 0.  ,0.  f RN»  1 * IFRY  YFS 

■ YSC.H.I)  = YSr‘»  +UIASl,n+KNYSO(J)  YFS 

IMYSClfJ)»U*0.0)' YSCINIbO.O  YF’S 

10  COiniK’iJF  ’ ■ YFS 

C YFS 

C -IF’  RLFOin  OPTION  ON.  PRtNT  LINE  ON  REPORT  YFS 

IMPUInTF.EO.OJ  go  TU  90  YFS  ' 

CALL  1 2.l:HiU/.ULlUj).I00n  YFS 

EW=fl.Oo0001  - YFS 

IF(YSTr.GT,0.0}FR=0.0  YfS 

p[  HCnTcA8R(Y3C1(J)-YSYH)/(YSTR  + FR)’M00;  YFS 

CALI  PaCERCD  YFS 

6R1T1  (nil TP  1 11)601  10UT(3)  . IOOT(3)  » lOUT  (1  ) t YSTRs  YSCI  (J)  »HERCNT  iSlH  J)  Yf  S 
lOfeO  HIR.9AT  (6X,  13,18/ » 12.1  H/.  12. 9X.F  I 0 .2»9X  . F 1 0 ,2)  6X t F 6.2.2X ,K  1 0 ,2T  YF  S 

'90  COKTit-uF  • YFS 

50  CONTIMuF  YFS 

C ' YFS 

C WRITL  RFCORO  TO  OUTPUT  FII.E  ..  YFS  ' 

hRITF.fvf  SnUT)|  in,IRFGlO,IZONIOf  ISTRTO.YSTR*  YFS 

1 U/P|<0L)(J)TVsr.HJ),VSYCF(J)iJ=lt6)  YFS 

NYtSK=NY£SK+l  YFS 

C YFS 

C read  next  Rl’CORl)  • YFS 

1F(  F»f  t;.fcO.FHUK.AN0.I70ML  .EO  .FNOZ  ) IFnO=  1 yFs 

RF  AlU  YE«F  RIO  COON.  TRIG.  170NE  f 1 3 J B AT  f Y TRUF  ♦ YFS 

1 (UllLlUt)iUlASm.S0(I)»I  = l»6)  YFS 

NRtr(S)=NRF.r(5l  + l ' . ' ■ Yf  S 

ir{r.Ni)/.Lo,o,Atn.cuUN  ,nf  . il'il)  go  to  32  ' ' yfs 

■lF(FWt>2.EO.ft.A,j[).C0IJN  .FtJ.ZZ/Z)  GO  |To  60  ‘ YFS 

! IFUFMO. 10,0, Alio, rOim.LO.'UlZZZZ)  GO  TO’55  YFS 

IF((If  NO, EO.  11.4(40, a!.'tG.NF..LNOR. OB, IZONt.KF.ENOZ)  YF'S 

1 .AI.O.CbUN.Nr.'lHZZZZl  00  TO  Sb  YES 

IF(rOliN.EO,9MZZZZ)  GO  TO  60  . . YFS 

" GO  to  22  - YF  S ' 

C .YFS 

0 cannot  find  ending  zone  yfs 

S5  CONTl'NiiF  YFS 

C Kl  PORT  ( RRlIR  Yl  S 

CALL  FRRHr.S(3HYrS.iHYFS,2.0)  YFS 

. 60  c-ontinuf  yfs 

c ^ ^ Y r s 

C ■ KRITF.  TRATLFH  HFLOHO  TO  OUTPUT  F I'l  E ANO  CLEAN  UP  YFS 

MRF.C(S)=  NRFC(b)-l  VFS 

I n' (1R  = | YLSO-r  ' Y(  5 

hllin.(Yl  Gmn)ZZ7/,UF  ILLiIaltlTKUP)  Yf  S 
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000179  HFWiNn  YtSUUr  IffS 

000160  RtVfTND  YESERR  VEs 

000  161  HFTIJHH  Yf-S 

000162  ENO  YFS 
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> FLT  YSUB»l»760<j27f  3,<)iO0  t 1‘ 


OOOOOl 

■ 

FUNCTION  YSU8  (AAtB) 

YSUB 

- 000002  ■ 

c 

COMpUTFS  THE  CHJANTITY  Y USED  IN  THE  CONFIOENCfc  LEVEU 

Ysun 

OOOOOi 

c 

. CAl  cULAllO-lS. 

ysub 

■OOOOO'l 

. c 

- 

YSUB 

000005 

c 

CilUlMG  SFOUfcNcE  PAHAMETLRS  ...  . 

YSUB 

000006 

c 

AA-b  VAHlA'ICE  . 

YSun 

000007 

c 

n = KFlEHClXE  VALUE 

YSUB 

onoooa 

c 

YSUB 

000009 

c 

AHfUjNtNT  LM'T  FOR  ERROR  PROCESSING 

akglst 

0000  1 0 

COMMON  /AKGLSl/ 

arglst 

000011 

1 UERrS  ,NFArAL*NPERRS,NARG  »ARG(10)  ' 

apglst 

000012 

' 

OTHfNSlON  IaR(UIO) 

ARgI  ST 

000015 

EOUIVAlFUCE  t lAROfARG  ) 

APGI  ST 

000014 

c 

. 

ARGI.ST 

000015 

' 

c 

A 

YSUB 

0 0 0 0 1 0 

DATA  ICTP  / 0 / 

YSUH 

OOOOl  / 

c 

VSUR 

ooooia. 

c 

• 

YSUB 

000019 

A=  AA 

' YSUB 

000020 

IF  ( A ,GT.  0.0  ) GO  TO  120 

ysuiy- 

000021 

• c 

YSUB 

000022 

c 

A ISGFGATIVE  OH  ZERO, 

YSUB 

000025 

IF  ( -A  .t-T.  l.E-7*fl  ) GO  TO  llO 

YSUB 

000024 

ARG(3)=  A 

YSUB 

000025 

ARG(‘0=  It  . ’ ■ 

YSUH 

000026 

KTP=  iFTt!  + 1 

YSUB 

0.0  0 02/ 

IF  ( ICTR  .LT.  6 ) CALL  ERRHES  (3HCASt4HYSUBf  16t0)  . 

YSUB 

000020 

lio 

A=  0,0 

YSUB 

■ c 

. 

YSUB 

0000.30 

120 

Y'SUfl=  aMAXI  ( 8ORTlA),l.t-30  ) 

YSUB 

OOOOTl 

c 

YSUB- 

OOOOT2 

0000 

«J00 

RFTIWN'  . . 

END 

YSUB 

YSUB 

11.  TOC 
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